Results 1 to 11 of 11
  1. #1
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,420
    Thanks
    124
    Thanked 5 Times in 5 Posts

    Macro to show sheet name and value where the is a variance

    I need help in amending the macro "Extract variances"

    I have a macro to extract variances in Col H on all sheets where the value is not zero on sheet “variance”. Where there are variances the sheet number is extracted in Col A on sheet "variance" and the value of the variance in Col C on sheet “Variance”


    However on sheets HO, HO1, HO3, KI10 & NSS the variances are in Cols J and I have tried to write code to accommodate this


    When running the macro I get a compile error and it appears to be this line of code that is causing the problem

    If .Name = "HO" Or .Name = "HO1" Or .Name = "HO2" Or .Name = "KI10" Or .Name = "NSS" Then


    It would be appreciated if someone could kindly assist me
    Attached Files Attached Files

  2. #2
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,633
    Thanks
    115
    Thanked 647 Times in 590 Posts
    Howard,

    You had 3 missing lines to your code (in blue):

    Code:
    Sub Extract_Variances()
    Sheets("variance").Select
      Dim wks As Worksheet
      Dim sht As Worksheet
      Dim rng As Range
      Dim lng As Long
      Application.DisplayAlerts = False
      On Error Resume Next
      Worksheets("Variance").Delete
      On Error GoTo 0
      Application.DisplayAlerts = True
      Set sht = Worksheets.Add(Sheets(1))
      With sht 'MISSING
      sht.Name = "Variance"
      sht.Range("A1:C1").Value = Array("Sheet", "Address", "Value")
      lng = 1
      For Each wks In ActiveWorkbook.Worksheets
           If .Name = "HO1" Or .Name = "HO2" Or .Name = "KI10" Or .Name = "KI11" Or .Name = "NSS" Then
          
                If wks.Index > 1 And Not Intersect(wks.Columns("j"), wks.UsedRange) Is Nothing Then
                    For Each rng In Intersect(wks.Columns("j"), wks.UsedRange)
                        If IsNumeric(rng.Value) And rng.Value <> 0 Then
                            lng = 1 + lng
                            sht.Cells(lng, 1).Resize(, 3).Value = _
                              Array(rng.Parent.Name, rng.Address(False, False), rng.Value)
                            sht.Cells(lng, 3).NumberFormat = rng.NumberFormat
                        End If
                    Next rng
                End If
            Else
             
                If wks.Index > 1 And Not Intersect(wks.Columns("h"), wks.UsedRange) Is Nothing Then
                    For Each rng In Intersect(wks.Columns("h"), wks.UsedRange)
                      If IsNumeric(rng.Value) And rng.Value <> 0 Then
                            lng = 1 + lng
                            sht.Cells(lng, 1).Resize(, 3).Value = _
                              Array(rng.Parent.Name, rng.Address(False, False), rng.Value)
                            sht.Cells(lng, 3).NumberFormat = rng.NumberFormat
                      End If
                    Next rng
                End If
            End If 'MISSING
      Next wks
      End With 'MISSING
      Compute_Formulas
      Delete_Various
      
    End Sub
    I would suggest indenting your code better to pick up on potential mis-pairing of statements however I commend your efforts in trying.

    Maud

  3. The Following User Says Thank You to Maudibe For This Useful Post:

    HowardC (2015-10-25)

  4. #3
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,420
    Thanks
    124
    Thanked 5 Times in 5 Posts
    Thanks for the help Maud

    When running the macro, for HO, HO1, HO3, KI10 & NSS m the variances are in Col J, all the other sheets the variance is in Col H

    Please check & amend code accordingly
    Attached Files Attached Files

  5. #4
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,633
    Thanks
    115
    Thanked 647 Times in 590 Posts
    Howard,

    To sort the code to run for specific sheets, try these changes. I have also made a slight adjustment to avoid the Type mismatch error when the variance = #N/A such as in sheet BR9.

    HTH,
    Maud

    Code:
    Sub Extract_Variances()
    Sheets("variance").Select
      Dim wks As Worksheet
      Dim sht As Worksheet
      Dim rng As Range
      Dim lng As Long, num As Integer
      Application.DisplayAlerts = False
      On Error Resume Next
      Worksheets("Variance").Delete
      On Error GoTo 0
      Application.DisplayAlerts = True
      Set sht = Worksheets.Add(Sheets(1))
      sht.Name = "Variance"
      sht.Range("A1:C1").Value = Array("Sheet", "Address", "Value")
      lng = 1
      For Each wks In ActiveWorkbook.Worksheets
           With wks
           If .Name = "HO1" Or .Name = "HO2" Or .Name = "KI10" Or .Name = "KI11" Or .Name = "NSS" Then
          
                If wks.Index > 1 And Not Intersect(wks.Columns("j"), wks.UsedRange) Is Nothing Then
                    For Each rng In Intersect(wks.Columns("j"), wks.UsedRange)
                        If IsNumeric(rng.Value) Then
                            If rng.Value <> 0 Then
                                lng = 1 + lng
                                sht.Cells(lng, 1).Resize(, 3).Value = _
                                  Array(rng.Parent.Name, rng.Address(False, False), rng.Value)
                                sht.Cells(lng, 3).NumberFormat = rng.NumberFormat
                            End If
                        End If
                    Next rng
                End If
            Else
             
                If wks.Index > 1 And Not Intersect(wks.Columns("h"), wks.UsedRange) Is Nothing Then
                    For Each rng In Intersect(wks.Columns("h"), wks.UsedRange)
                        If IsNumeric(rng.Value) Then
                            If rng.Value <> 0 Then
                                lng = 1 + lng
                                sht.Cells(lng, 1).Resize(, 3).Value = _
                                  Array(rng.Parent.Name, rng.Address(False, False), rng.Value)
                                sht.Cells(lng, 3).NumberFormat = rng.NumberFormat
                            End If
                        End If
                    Next rng
                End If
            End If
            End With
      Next wks
      Compute_Formulas
      Delete_Various
      
    End Sub

  6. The Following User Says Thank You to Maudibe For This Useful Post:

    HowardC (2015-10-25)

  7. #5
    WS Lounge VIP
    Join Date
    Mar 2002
    Location
    Newcazzle, UK
    Posts
    2,823
    Thanks
    135
    Thanked 481 Times in 458 Posts
    Hi Howard

    see attached file.

    This is the code I used:
    Code:
    Sub Extract_Variances()
    Sheets("variance").Select
      Dim wks As Worksheet
      Dim sht As Worksheet
      Dim rng As Range
      Dim lng As Long
      
      Application.DisplayAlerts = False
      On Error Resume Next
      Worksheets("Variance").Delete
      On Error GoTo 0
      Application.DisplayAlerts = True
      
      Set sht = Worksheets.Add(Sheets(1))
      sht.Name = "Variance"
      sht.Range("A1:C1").Value = Array("Sheet", "Address", "Value")
      
      lng = 1
      '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      For Each wks In ActiveWorkbook.Worksheets
      zSht = wks.Name
      zCol = "h"
      If zSht = "HO1" Or zSht = "HO2" Or zSht = "KI10" Or zSht = "KI11" Or zSht = "NSS" Then
      zCol = "j"
      End If
        
      If wks.Index > 1 And Not Intersect(wks.Columns(zCol), wks.UsedRange) Is Nothing Then
        For Each rng In Intersect(wks.Columns(zCol), wks.UsedRange)
        If IsNumeric(rng) Then
        If rng <> 0 Then
        lng = 1 + lng
        sht.Cells(lng, 1).Resize(, 3).Value = _
        Array(rng.Parent.Name, rng.Address(False, False), rng.Value)
        sht.Cells(lng, 3).NumberFormat = rng.NumberFormat
        End If
        End If
        Next rng
      End If
      Next wks
      '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      Compute_Formulas
      Delete_Various
      
    End Sub
    A couple of points, in addition to those raised by Maud:
    1. Try and avoid using sheet names that can be confused with cell addresses (like HO1, BR9 etc etc)
    2. Investigate using Select Case (instead of multiple Or this Or that Or whatever)

    Note:
    If a cell contains #N/A (as per sheet [BR9] in your posted example, then your vba code line
    If IsNumeric(rng.Value) And rng.Value <> 0 Then
    ..will trigger an error

    zeddy
    Attached Files Attached Files

  8. The Following User Says Thank You to zeddy For This Useful Post:

    HowardC (2015-10-25)

  9. #6
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,420
    Thanks
    124
    Thanked 5 Times in 5 Posts
    Hi Maud

    Thanks for amending your code as well as for your input

    Code works perfectly

  10. #7
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,420
    Thanks
    124
    Thanked 5 Times in 5 Posts
    Hi Zeddy

    Thanks for your help as well as your pointers

  11. #8
    WS Lounge VIP
    Join Date
    Mar 2002
    Location
    Newcazzle, UK
    Posts
    2,823
    Thanks
    135
    Thanked 481 Times in 458 Posts
    Hi Howard

    ..I hope you noticed how I shortened the code

    zeddy

  12. The Following User Says Thank You to zeddy For This Useful Post:

    HowardC (2015-10-25)

  13. #9
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,434
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Zeddy,

    Just for kicks how about...
    Code:
      If InStr(" HO1 HO2 KI10 KI11 NSS ", zsht) > 0 Then
        zCol = "j"
      End If
    ...for shorter?

    HTH
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  14. The Following User Says Thank You to RetiredGeek For This Useful Post:

    zeddy (2015-10-25)

  15. #10
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,420
    Thanks
    124
    Thanked 5 Times in 5 Posts
    Hi Zeddy

    I did indeed

  16. The Following User Says Thank You to HowardC For This Useful Post:

    zeddy (2015-10-25)

  17. #11
    WS Lounge VIP
    Join Date
    Mar 2002
    Location
    Newcazzle, UK
    Posts
    2,823
    Thanks
    135
    Thanked 481 Times in 458 Posts
    Hi Howard

    ..we always appreciate your feedback.

    zeddy

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •