Help with IF statement to VBA code

ana_c

New Member
Joined
May 26, 2021
Messages
17
Office Version
  1. 365
Platform
  1. Windows
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)
1623147073733.png


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
1623147155773.png


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
 

Attachments

  • 1623146514969.png
    1623146514969.png
    7.8 KB · Views: 2
  • 1623146641282.png
    1623146641282.png
    18.2 KB · Views: 0

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
13,632
Office Version
  1. 2007
Platform
  1. Windows
Try this:

VBA Code:
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
 
Solution

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
13,632
Office Version
  1. 2007
Platform
  1. Windows
I'm glad to help you. Thanks for the feedback.
 

Forum statistics

Threads
1,141,769
Messages
5,708,425
Members
421,568
Latest member
Huxley

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top