Looking For Tips To Improve My VBA

W

who am i

New Member
Joined
Oct 28, 2024
Messages
10
Office Version
  1. 2019
I am very new to VBA and though below works, I bet it can be written more concisely. Thank you so much!

VBA Code: 
Sub trial_v2()
  Dim Sales_Rep As Integer
  Dim IMR As Integer
  Dim DOWN_PAYMENT As Integer
  Dim Tax_Adj As Integer
  Dim Material As Integer
  Dim Service_Item As Integer
  Dim Last_Row As Long
  Dim i As Long
 
 
    Application.ScreenUpdating = False
 
  With Sheets("Sheet1")
  
    Last_Row = Range("a" & Rows.Count).End(xlUp).Row
  
  
    Sales_Rep = .Rows(1).Find(What:="Sales Representative Name", LookAt:=xlWhole, MatchCase:=False).Column
    .Columns(Sales_Rep + 1).Insert
     .Range(.Cells(2, Sales_Rep + 1), .Cells(Last_Row, Sales_Rep + 1)).Formula2R1C1 = "=VLOOKUP(RC[-1],'[Book1.xlsm]IMR Table'!C1:C2,2,FALSE)"
 
   .Cells(1, Sales_Rep + 1).FormulaR1C1 = "IMR"
    IMR = Sales_Rep + 1
  
  
    .Columns(IMR).Copy
    .Columns(IMR).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  
    .Columns(Sales_Rep).Delete
  
  
    Last_Row = Range("a" & Rows.Count).End(xlUp).Row
  
  
  
  
    .Cells(1, Columns.Count).End(xlToLeft).Offset(0, 3).Formula = "Down Payment?"
    DOWN_PAYMENT = .Rows(1).Find(What:="Down Payment?", LookAt:=xlWhole, MatchCase:=False).Column
    .Range(.Cells(2, DOWN_PAYMENT), .Cells(Last_Row, DOWN_PAYMENT)).Formula2R1C1 = _
    "=or(isnumber(search(""Down Pay"",INDEX(C[" & 1 + (0 - DOWN_PAYMENT) & "]:C,row(RC),match(""Material"",(R1),0)))),isnumber(search(""Down Pay"",INDEX(C[" & 1 + (0 - DOWN_PAYMENT) & "]:C,row(RC),match(""Billing Type Description"",(R1),0)))),isnumber(search(""Down Pay"",INDEX(C[" & 1 + (0 - DOWN_PAYMENT) & "]:C,row(RC),match(""Material Description"",(R1),0)))))"
 
  For i = Last_Row To 2 Step -1
  If Cells(i, DOWN_PAYMENT).Value = True Then
            Rows(i).EntireRow.Delete
        End If
           
          Next i
        
        
.Columns(DOWN_PAYMENT).Delete


Last_Row = Range("a" & Rows.Count).End(xlUp).Row
 
    .Cells(1, Columns.Count).End(xlToLeft).Offset(0, 3).Formula = "Tax Adj?"
    Tax_Adj = .Rows(1).Find(What:="Tax Adj?", LookAt:=xlWhole, MatchCase:=False).Column
    .Range(.Cells(2, Tax_Adj), .Cells(Last_Row, Tax_Adj)).Formula2R1C1 = _
    "=or(isnumber(search(""TAXADJ"",INDEX(C[" & 1 + (0 - Tax_Adj) & "]:C,row(RC),match(""Material"",(R1),0)))),isnumber(search(""Tax Adj"",INDEX(C[" & 1 + (0 - Tax_Adj) & "]:C,row(RC),match(""Material Description"",(R1),0)))))"
 
  For i = Last_Row To 2 Step -1
  If Cells(i, Tax_Adj).Value = True Then
            Rows(i).EntireRow.Delete
        End If
           
          Next i
 
 
    
.Columns(Tax_Adj).Delete


Last_Row = Range("a" & Rows.Count).End(xlUp).Row


.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 3).Formula = "Service Item?"
    Service_Item = .Rows(1).Find(What:="Service Item?", LookAt:=xlWhole, MatchCase:=False).Column
    Material = .Rows(1).Find(What:="Material", LookAt:=xlWhole, MatchCase:=False).Column
    .Range(.Cells(2, Service_Item), .Cells(Last_Row, Service_Item)).Formula2R1C1 = _
    "=ISNUMBER(MATCH(RC[" & (Material - Service_Item) & "],'[Book1.xlsm]IMR Table'!C9,0))"
 
  For i = Last_Row To 2 Step -1
  If Cells(i, Service_Item).Value = True Then
            Rows(i).EntireRow.Delete
        End If
           
          Next i
 
 
    
.Columns(Service_Item).Delete


Last_Row = Range("a" & Rows.Count).End(xlUp).Row

.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 3).Formula = "Blank Project ID?"
    Blank_Project_ID = .Rows(1).Find(What:="Blank Project ID?", LookAt:=xlWhole, MatchCase:=False).Column
    Project_ID = .Rows(1).Find(What:="Project ID", LookAt:=xlWhole, MatchCase:=False).Column
    .Range(.Cells(2, Blank_Project_ID), .Cells(Last_Row, Blank_Project_ID)).Formula2R1C1 = _
    "=AND(VALUE(RC1)>0,LEN(RC[" & (Project_ID - Blank_Project_ID) & "])<2)"





  
  
  
     Application.ScreenUpdating = True
   
   
      End With
   
         Cells(1, 1).Select
  
End Sub
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
Sort by date Sort by votes
Not sure what sort of improvements you're looking for. IMO, you have only two variable types declared yet have eight lines, so room for condensing there. Then there seems to be a few unnecessary double spaced (or more ?) lines and the indentation is not what I would call "correct". However, none of that will affect the way it runs - it's just not as easy to follow and as concise as it could be. Is it as efficient as it could be? Don't know as I tend to gloss over code that is written/indented like that if I'm not looking for a run-time type of problem in need of a solution.
 
Upvote 0
Currently your code has 3 sections that are deleted row by row.
I replaced those sections to delete all the rows with a single instruction.

Replace your code with the following:

VBA Code: 
Sub trial_v3()
  Dim sh As Worksheet
  Dim Last_Row As Long, i As Long, n As Long, col As Long
  Dim arT As Variant
  Dim f As Range, f2 As Range, rng As Range
  Dim IMR As Integer, Sales_Rep As Integer, Blank_Project_ID As Integer, Project_ID As Integer
 
  Application.ScreenUpdating = False
 
  Set sh = Sheets("Sheet1")
 
  Last_Row = sh.Range("A" & Rows.Count).End(xlUp).Row
  Sales_Rep = sh.Rows(1).Find(What:="Sales Representative Name", LookAt:=xlWhole, MatchCase:=False).Column
  sh.Columns(Sales_Rep + 1).Insert
  sh.Range(sh.Cells(2, Sales_Rep + 1), sh.Cells(Last_Row, Sales_Rep + 1)).FormulaR1C1 = _
    "=VLOOKUP(RC[-1],'[Book1.xlsm]IMR Table'!C1:C2,2,FALSE)"
  sh.Cells(1, Sales_Rep + 1).FormulaR1C1 = "IMR"
  IMR = Sales_Rep + 1
  sh.Columns(IMR).Copy
  sh.Columns(IMR).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  sh.Columns(Sales_Rep).Delete
  
  'DELETE ROWS
  Set rng = Range("A" & Last_Row + 1)
  arT = Array("Material", "Material Description", "Billing Type Description")
 
  For n = 0 To UBound(arT)
    Set f = sh.Range("1:1").Find(arT(n), , xlValues, xlWhole, , , False)
    If Not f Is Nothing Then
      col = f.Column
    
      For i = 2 To Last_Row
      
        If n = 0 Then     'material
          If InStr(1, sh.Cells(i, f.Column).Value, "Down Pay", vbTextCompare) > 0 Or _
             InStr(1, sh.Cells(i, f.Column).Value, "TAXADJ", vbTextCompare) > 0 Then
             Set rng = Union(rng, sh.Range("A" & i))
          End If
        
          '"=ISNUMBER(MATCH(RC[" & (Material - Service_Item) & "],'[Book1.xlsm]IMR Table'!C9,0))"
          If sh.Range("C" & i).Value <> "" Then
            Set f2 = Workbooks("Book1").Sheets("IMR Table").Range("I:I").Find( _
              sh.Range("C" & i).Value, , xlValues, xlWhole, , , False)
            If Not f2 Is Nothing Then Set rng = Union(rng, sh.Range("A" & i))
          End If
        End If
      
        If n = 1 Then      'Material Description
          If InStr(1, sh.Cells(i, f.Column).Value, "Down Pay", vbTextCompare) > 0 Or _
             InStr(1, sh.Cells(i, f.Column).Value, "Tax Adj", vbTextCompare) > 0 Then
             Set rng = Union(rng, sh.Range("A" & i))
          End If
        End If
       
        If n = 2 Then     'Billing Type Description
          If InStr(1, sh.Cells(i, f.Column).Value, "Down Pay", vbTextCompare) > 0 Then
             Set rng = Union(rng, sh.Range("A" & i))
          End If
        End If
      Next
    End If
  Next
 
  If Not rng Is Nothing Then
    rng.EntireRow.Delete
  End If
  'END DELETE ROWS
  
  Last_Row = sh.Range("a" & Rows.Count).End(xlUp).Row
  sh.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 3).Formula = "Blank Project ID?"
  Blank_Project_ID = sh.Rows(1).Find(What:="Blank Project ID?", LookAt:=xlWhole, MatchCase:=False).Column
  Project_ID = sh.Rows(1).Find(What:="Project ID?", LookAt:=xlWhole, MatchCase:=False).Column
  sh.Range(sh.Cells(2, Blank_Project_ID), sh.Cells(Last_Row, Blank_Project_ID)).FormulaR1C1 = _
    "=AND(VALUE(RC1)>0,LEN(RC[" & (Project_ID - Blank_Project_ID) & "])<2)"
  
  Application.ScreenUpdating = True
End Sub

The size of the macro was probably not reduced, but it will certainly be faster at deleting records.

Try and comment.
😅
 
Upvote 0
Solution
DanteAmor said:
The size of the macro was probably not reduced, but it will certainly be faster at deleting records.
Click to expand...

Now I was able to reduce the row deletion section. I also eliminated a couple of cycles, now the execution should be faster.

VBA Code: 
Sub trial_v4()
  Dim sh As Worksheet
  Dim Last_Row As Long, i As Long, n As Long, col1 As Long, col2 As Long, col3 As Long
  Dim fa As Range, fb As Range, fc As Range, f2 As Range, rng As Range
  Dim IMR As Integer, Sales_Rep As Integer, Blank_Project_ID As Integer, Project_ID As Integer
 
  Application.ScreenUpdating = False
 
  Set sh = Sheets("Sheet1")
 
  Last_Row = sh.Range("A" & Rows.Count).End(xlUp).Row
  Sales_Rep = sh.Rows(1).Find(What:="Sales Representative Name", LookAt:=xlWhole, MatchCase:=False).Column
  sh.Columns(Sales_Rep + 1).Insert
  sh.Range(sh.Cells(2, Sales_Rep + 1), sh.Cells(Last_Row, Sales_Rep + 1)).FormulaR1C1 = _
    "=VLOOKUP(RC[-1],'[Book1.xlsm]IMR Table'!C1:C2,2,FALSE)"
  sh.Cells(1, Sales_Rep + 1).FormulaR1C1 = "IMR"
  IMR = Sales_Rep + 1
  sh.Columns(IMR).Copy
  sh.Columns(IMR).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  sh.Columns(Sales_Rep).Delete
  
  'DELETE ROWS
    Set rng = Range("A" & Last_Row + 1)
    arT = Array("Material", "Material Description", "Billing Type Description")
    col1 = sh.Range("1:1").Find("Material", , xlValues, xlWhole, , , False).Column
    col2 = sh.Range("1:1").Find("Material Description", , xlValues, xlWhole, , , False).Column
    col3 = sh.Range("1:1").Find("Billing Type Description", , xlValues, xlWhole, , , False).Column
 
    For i = 2 To Last_Row
      If InStr(1, sh.Cells(i, col1).Value, "Down Pay", vbTextCompare) > 0 Or _
         InStr(1, sh.Cells(i, col1).Value, "TAXADJ", vbTextCompare) > 0 Or _
         InStr(1, sh.Cells(i, col2).Value, "Down Pay", vbTextCompare) > 0 Or _
         InStr(1, sh.Cells(i, col2).Value, "Tax Adj", vbTextCompare) > 0 Or _
         InStr(1, sh.Cells(i, col3).Value, "Down Pay", vbTextCompare) > 0 Then
         Set rng = Union(rng, sh.Range("A" & i))
      End If
    
      '"=ISNUMBER(MATCH(RC[" & (Material - Service_Item) & "],'[Book1.xlsm]IMR Table'!C9,0))"
      If sh.Range("C" & i).Value <> "" Then
        Set f2 = Workbooks("Book1").Sheets("IMR Table").Range("I:I").Find( _
          sh.Range("C" & i).Value, , xlValues, xlWhole, , , False)
        If Not f2 Is Nothing Then Set rng = Union(rng, sh.Range("A" & i))
      End If
    Next
 
    rng.EntireRow.Delete
  'END DELETE ROWS
  
  Last_Row = sh.Range("a" & Rows.Count).End(xlUp).Row
  sh.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 3).Formula = "Blank Project ID?"
  Blank_Project_ID = sh.Rows(1).Find(What:="Blank Project ID?", LookAt:=xlWhole, MatchCase:=False).Column
  Project_ID = sh.Rows(1).Find(What:="Project ID?", LookAt:=xlWhole, MatchCase:=False).Column
  sh.Range(sh.Cells(2, Blank_Project_ID), sh.Cells(Last_Row, Blank_Project_ID)).FormulaR1C1 = _
    "=AND(VALUE(RC1)>0,LEN(RC[" & (Project_ID - Blank_Project_ID) & "])<2)"
  
  Application.ScreenUpdating = True
End Sub

😇
 
Upvote 0
We can also reduce this code:
VBA Code: 
  Last_Row = sh.Range("A" & Rows.Count).End(xlUp).Row
  Sales_Rep = sh.Rows(1).Find(What:="Sales Representative Name", LookAt:=xlWhole, MatchCase:=False).Column
  sh.Columns(Sales_Rep + 1).Insert
  sh.Range(sh.Cells(2, Sales_Rep + 1), sh.Cells(Last_Row, Sales_Rep + 1)).FormulaR1C1 = _
    "=VLOOKUP(RC[-1],'[Book1.xlsm]IMR Table'!C1:C2,2,FALSE)"
  sh.Cells(1, Sales_Rep + 1).FormulaR1C1 = "IMR"
  IMR = Sales_Rep + 1
  sh.Columns(IMR).Copy
  sh.Columns(IMR).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  sh.Columns(Sales_Rep).Delete

To this:
VBA Code: 
  Last_Row = sh.Range("A" & Rows.Count).End(xlUp).Row
  Sales_Rep = sh.Rows(1).Find(What:="Sales Representative Name", LookAt:=xlWhole, MatchCase:=False).Column
  With sh.Range(sh.Cells(2, Sales_Rep), sh.Cells(Last_Row, Sales_Rep))
    .Value = Evaluate("=IF({1},VLOOKUP(T(IF({1}," & .Address & ")),'[book1.xlsm]IMR Table'!$A:$B,2,0))")
  End With
  sh.Cells(1, Sales_Rep).Value = "IMR"
The above does not insert and delete the column. It also evaluates and enters the result without having to enter the VLOOKUP formula on the sheet, Which will also make the macro faster.

Complete code:
VBA Code: 
Sub trial_v4()
  Dim sh As Worksheet
  Dim Last_Row As Long, i As Long, n As Long, col1 As Long, col2 As Long, col3 As Long
  Dim fa As Range, fb As Range, fc As Range, f2 As Range, rng As Range
  Dim Sales_Rep As Integer, Blank_Project_ID As Integer, Project_ID As Integer
  
  Application.ScreenUpdating = False
 
  Set sh = Sheets("Sheet1")
 
  Last_Row = sh.Range("A" & Rows.Count).End(xlUp).Row
  Sales_Rep = sh.Rows(1).Find(What:="Sales Representative Name", LookAt:=xlWhole, MatchCase:=False).Column
  With sh.Range(sh.Cells(2, Sales_Rep), sh.Cells(Last_Row, Sales_Rep))
    .Value = Evaluate("=IF({1},VLOOKUP(T(IF({1}," & .Address & ")),'[book1.xlsm]IMR Table'!$A:$B,2,0))")
  End With
  sh.Cells(1, Sales_Rep).Value = "IMR"
  
  'DELETE ROWS
    Set rng = Range("A" & Last_Row + 1)
    col1 = sh.Range("1:1").Find("Material", , xlValues, xlWhole, , , False).Column
    col2 = sh.Range("1:1").Find("Material Description", , xlValues, xlWhole, , , False).Column
    col3 = sh.Range("1:1").Find("Billing Type Description", , xlValues, xlWhole, , , False).Column
 
    For i = 2 To Last_Row
      If InStr(1, sh.Cells(i, col1).Value, "Down Pay", vbTextCompare) > 0 Or _
         InStr(1, sh.Cells(i, col1).Value, "TAXADJ", vbTextCompare) > 0 Or _
         InStr(1, sh.Cells(i, col2).Value, "Down Pay", vbTextCompare) > 0 Or _
         InStr(1, sh.Cells(i, col2).Value, "Tax Adj", vbTextCompare) > 0 Or _
         InStr(1, sh.Cells(i, col3).Value, "Down Pay", vbTextCompare) > 0 Then
         Set rng = Union(rng, sh.Range("A" & i))
      End If
    
      '"=ISNUMBER(MATCH(RC[" & (Material - Service_Item) & "],'[Book1.xlsm]IMR Table'!C9,0))"
      If sh.Range("C" & i).Value <> "" Then
        Set f2 = Workbooks("Book1").Sheets("IMR Table").Range("I:I").Find( _
          sh.Range("C" & i).Value, , xlValues, xlWhole, , , False)
        If Not f2 Is Nothing Then Set rng = Union(rng, sh.Range("A" & i))
      End If
    Next
 
    rng.EntireRow.Delete
  'END DELETE ROWS
  
  Last_Row = sh.Range("a" & Rows.Count).End(xlUp).Row
  sh.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 3).Formula = "Blank Project ID?"
  Blank_Project_ID = sh.Rows(1).Find(What:="Blank Project ID?", LookAt:=xlWhole, MatchCase:=False).Column
  Project_ID = sh.Rows(1).Find(What:="Project ID?", LookAt:=xlWhole, MatchCase:=False).Column
  sh.Range(sh.Cells(2, Blank_Project_ID), sh.Cells(Last_Row, Blank_Project_ID)).FormulaR1C1 = _
    "=AND(VALUE(RC1)>0,LEN(RC[" & (Project_ID - Blank_Project_ID) & "])<2)"
  
  Application.ScreenUpdating = True
End Sub

🧙‍♂️
 
Upvote 0
Thanks so much Dante!!! Reading messages now in order to test and make sure I understand. Thank you!
 
Upvote 0
DanteAmor said:
We can also reduce this code:
VBA Code: 
  Last_Row = sh.Range("A" & Rows.Count).End(xlUp).Row
  Sales_Rep = sh.Rows(1).Find(What:="Sales Representative Name", LookAt:=xlWhole, MatchCase:=False).Column
  sh.Columns(Sales_Rep + 1).Insert
  sh.Range(sh.Cells(2, Sales_Rep + 1), sh.Cells(Last_Row, Sales_Rep + 1)).FormulaR1C1 = _
    "=VLOOKUP(RC[-1],'[Book1.xlsm]IMR Table'!C1:C2,2,FALSE)"
  sh.Cells(1, Sales_Rep + 1).FormulaR1C1 = "IMR"
  IMR = Sales_Rep + 1
  sh.Columns(IMR).Copy
  sh.Columns(IMR).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  sh.Columns(Sales_Rep).Delete

To this:
VBA Code: 
  Last_Row = sh.Range("A" & Rows.Count).End(xlUp).Row
  Sales_Rep = sh.Rows(1).Find(What:="Sales Representative Name", LookAt:=xlWhole, MatchCase:=False).Column
  With sh.Range(sh.Cells(2, Sales_Rep), sh.Cells(Last_Row, Sales_Rep))
    .Value = Evaluate("=IF({1},VLOOKUP(T(IF({1}," & .Address & ")),'[book1.xlsm]IMR Table'!$A:$B,2,0))")
  End With
  sh.Cells(1, Sales_Rep).Value = "IMR"
The above does not insert and delete the column. It also evaluates and enters the result without having to enter the VLOOKUP formula on the sheet, Which will also make the macro faster.

Complete code:
VBA Code: 
Sub trial_v4()
  Dim sh As Worksheet
  Dim Last_Row As Long, i As Long, n As Long, col1 As Long, col2 As Long, col3 As Long
  Dim fa As Range, fb As Range, fc As Range, f2 As Range, rng As Range
  Dim Sales_Rep As Integer, Blank_Project_ID As Integer, Project_ID As Integer
 
  Application.ScreenUpdating = False
 
  Set sh = Sheets("Sheet1")
 
  Last_Row = sh.Range("A" & Rows.Count).End(xlUp).Row
  Sales_Rep = sh.Rows(1).Find(What:="Sales Representative Name", LookAt:=xlWhole, MatchCase:=False).Column
  With sh.Range(sh.Cells(2, Sales_Rep), sh.Cells(Last_Row, Sales_Rep))
    .Value = Evaluate("=IF({1},VLOOKUP(T(IF({1}," & .Address & ")),'[book1.xlsm]IMR Table'!$A:$B,2,0))")
  End With
  sh.Cells(1, Sales_Rep).Value = "IMR"
 
  'DELETE ROWS
    Set rng = Range("A" & Last_Row + 1)
    col1 = sh.Range("1:1").Find("Material", , xlValues, xlWhole, , , False).Column
    col2 = sh.Range("1:1").Find("Material Description", , xlValues, xlWhole, , , False).Column
    col3 = sh.Range("1:1").Find("Billing Type Description", , xlValues, xlWhole, , , False).Column
 
    For i = 2 To Last_Row
      If InStr(1, sh.Cells(i, col1).Value, "Down Pay", vbTextCompare) > 0 Or _
         InStr(1, sh.Cells(i, col1).Value, "TAXADJ", vbTextCompare) > 0 Or _
         InStr(1, sh.Cells(i, col2).Value, "Down Pay", vbTextCompare) > 0 Or _
         InStr(1, sh.Cells(i, col2).Value, "Tax Adj", vbTextCompare) > 0 Or _
         InStr(1, sh.Cells(i, col3).Value, "Down Pay", vbTextCompare) > 0 Then
         Set rng = Union(rng, sh.Range("A" & i))
      End If
   
      '"=ISNUMBER(MATCH(RC[" & (Material - Service_Item) & "],'[Book1.xlsm]IMR Table'!C9,0))"
      If sh.Range("C" & i).Value <> "" Then
        Set f2 = Workbooks("Book1").Sheets("IMR Table").Range("I:I").Find( _
          sh.Range("C" & i).Value, , xlValues, xlWhole, , , False)
        If Not f2 Is Nothing Then Set rng = Union(rng, sh.Range("A" & i))
      End If
    Next
 
    rng.EntireRow.Delete
  'END DELETE ROWS
 
  Last_Row = sh.Range("a" & Rows.Count).End(xlUp).Row
  sh.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 3).Formula = "Blank Project ID?"
  Blank_Project_ID = sh.Rows(1).Find(What:="Blank Project ID?", LookAt:=xlWhole, MatchCase:=False).Column
  Project_ID = sh.Rows(1).Find(What:="Project ID?", LookAt:=xlWhole, MatchCase:=False).Column
  sh.Range(sh.Cells(2, Blank_Project_ID), sh.Cells(Last_Row, Blank_Project_ID)).FormulaR1C1 = _
    "=AND(VALUE(RC1)>0,LEN(RC[" & (Project_ID - Blank_Project_ID) & "])<2)"
 
  Application.ScreenUpdating = True
End Sub

🧙‍♂️
Click to expand...
Thank You so much Dante!!Your code worked!! I had to tweak this:

VBA Code: 
'"=ISNUMBER(MATCH(RC[" & (Material - Service_Item) & "],'[Book1.xlsm]IMR Table'!C9,0))"
      If sh.Range("C" & i).Value <> "" Then
        Set f2 = Workbooks("Book1").Sheets("IMR Table").Range("I:I").Find( _
          sh.Range("C" & i).Value, , xlValues, xlWhole, , ,

to:

VBA Code: 
'"=ISNUMBER(MATCH(RC[" & (Material - Service_Item) & "],'[Book1.xlsm]IMR Table'!C9,0))"
      If sh.Range("a" & i).Value <> "" Then
        Set f2 = Workbooks("Book1").Sheets("IMR Table").Range("I:I").Find( _
          sh.Range("t" & i).Value, , xlValues, xlWhole, , ,

by changing the ranges referenced. But I want to make the "t" reference change to col1 to be variable. How would I go about that?
 
Upvote 0
Rather than Range use Cells like in the psuedo code below (test on a blank sheet)

VBA Code: 
Sub TestCols()
    Dim myCol As Long, y As Long
    Dim i As Long, sh As Worksheet

    Set sh = ActiveSheet

    i = 3 ' The row number
    y = 7 ' just a counter to use as a value in the cells

    For myCol = 1 To 10 ' the column references from column A to J

        sh.Cells(i, myCol).Value = y
        y = y + 1

    Next

End Sub
 
Upvote 0
MARK858 said:
Rather than Range use Cells like in the psuedo code below (test on a blank sheet)

VBA Code: 
Sub TestCols()
    Dim myCol As Long, y As Long
    Dim i As Long, sh As Worksheet

    Set sh = ActiveSheet

    i = 3 ' The row number
    y = 7 ' just a counter to use as a value in the cells

    For myCol = 1 To 10 ' the column references from column A to J

        sh.Cells(i, myCol).Value = y
        y = y + 1

    Next

End Sub
Click to expand...
Right on!!!
 
Upvote 0
You must log in or register to reply here.

Similar threads

W
  • Solved
VBA of Match Formula using R1C1
Replies
2
Views
89
who am i
W
G
  • Solved
Run-Time Error 381
2
Replies
12
Views
201
Micron
M
J
  • Solved
VBA Code Error Unable to get the Match property of the WorksheetFunction class
Replies
8
Views
392
Jiraya_00
J
S
  • Question Question
Multiple columns lookup
Replies
0
Views
285
Sipirili2504
S
H
  • Solved
Macro to improve Optimisation
Replies
3
Views
192
Alex Blakenburg
A

Forum statistics

Threads
1,224,808
Messages
6,181,072
Members
453,020
Latest member
mattg2448

Share this page

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
Back
Top