Help with IF statement to VBA code

[ana_c]

Hi,

I'm trying to learn a bit more about conditional statements in macros. Can you help me adjust my VBA code based on a condition in a different sheet?

On sheet2, I have the following data on which I am running a macro (see code below screenshot)

Sub MyMacro()

Dim n As Long
Dim lc As Long, c As Long
Dim rng As Range
Dim lr As Long
Dim mx As Long

Application.ScreenUpdating = False

' Find last column in row 1 with data
lc = Cells(1, Columns.Count).End(xlToLeft).Column

' Initalize column value
c = 1

' Loop through each principal column
For n = 1 To lc
' Find largest row with data in column
lr = Cells(Rows.Count, c).End(xlUp).Row
' Build column range
Set rng = Range(Cells(2, c), Cells(lr, c))
' Find largest value in column
mx = Application.WorksheetFunction.Max(rng)
' Insert appropriate number of columns, if greater than 1
If mx > 1 Then
Range(Cells(1, c + 1), Cells(1, c + mx)).EntireColumn.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
' Insert formulas
Range(Cells(2, c + 1), Cells(lr, c + mx)).FormulaR1C1 = "=IF(COLUMN()-" & c & "=RC" & c & ",1,0)"
' Increment c for next set
c = c + mx + 1
Else
c = c + 1
End If
Next n

Application.ScreenUpdating = True

End Sub

And on sheet1, I have data that looks like this

The text in column G which also has tags in column J (i.e. row 1 and row 5) on sheet 1 matches the column headers on sheet 2.
I would like to modify the macro on sheet2 based on the "tag" column in sheet1 (column J). The condition is run the macro on sheet2 for all the columns that have a tag = 1 on sheet 1. If tag =0 then don't run the macro for those columns

Thanks in advance

 

[DanteAmor]

Try this:

Sub MyMacro()
  Dim sh As Worksheet
  Dim rng As Range, f As Range
  Dim n As Long, mx As Long
  Dim c As Long, lc As Long, lr As Long
  
  Application.ScreenUpdating = False
  
  Set sh = Sheets("Sheet1")
  ' Find last column in row 1 with data
  lc = Cells(1, Columns.Count).End(xlToLeft).Column
  ' Initalize column value
  c = 1
  
  ' Loop through each principal column
  For n = 1 To lc
    'Find header
    Set f = sh.Range("G:G").Find(Cells(1, c), , xlValues, xlWhole, , , False)
    If Not f Is Nothing Then
      'if tag = 1
      If f.Offset(0, 3).Value = 1 Then
        ' Find largest row with data in column
        lr = Cells(Rows.Count, c).End(xlUp).Row
        ' Build column range
        Set rng = Range(Cells(2, c), Cells(lr, c))
        ' Find largest value in column
        mx = Application.WorksheetFunction.Max(rng)
        ' Insert appropriate number of columns, if greater than 1
        If mx > 1 Then
          Range(Cells(1, c + 1), Cells(1, c + mx)).EntireColumn.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
          ' Insert formulas
          Range(Cells(2, c + 1), Cells(lr, c + mx)).FormulaR1C1 = "=IF(COLUMN()-" & c & "=RC" & c & ",1,0)"
          ' Increment c for next set
          c = c + mx + 1
        Else
          c = c + 1
        End If
      Else
        c = c + 1
      End If
    Else
      c = c + 1
    End If
  Next n
  
  Application.ScreenUpdating = True
End Sub

 

[ana_c]

Thank you!

This works

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.