index match excel formula to vba code

C

cooleomter

New Member
Joined
Sep 3, 2024
Messages
23
Office Version
  1. 365
  2. 2021
Platform
  1. Windows
Hi can you help me. how can i convert my excel formula to vba code. ( =@IFERROR(IFS($D$2="HDROP-15",INDEX(Serial!$E$2:$E$25426,MATCH('MASTER COPY'!E8,Serial!$A$2:$A$25426,0)),$D$2="HDROP-14",INDEX(Serial!$E$2:$E$25426,MATCH('MASTER COPY'!E8,Serial!$A$2:$A$25426,0)),$D$2="IND-B",INDEX(Serial!$D$2:$D$25426,MATCH('MASTER COPY'!E8,Serial!$A$2:$A$25426,0)),OR($D$2="HDROP-FK1",$D$2="JD2100",$D$2="JD2000WH",$D$2="JD2000BK"),INDEX(Serial!$B$2:$B$25426,MATCH('MASTER COPY'!E8,Serial!$A$2:$A$25426,0)),$D$2="ZR-02",INDEX(Serial!$F$2:$F$25426,MATCH('MASTER COPY'!E8,Serial!$A$2:$A$25426,0))),"")..this one is for column A...

and

this ones is for column b (=@IFERROR(IFS(OR($D$2="HDROP-14",$D$2="HDROP-15"),INDEX(Serial!$C$2:$C$25426,MATCH('MASTER COPY'!E8,Serial!$A$2:$A$25426,0))),"")

its serial matching index is taken from another sheet which is named Serial

my code is triggered in colunm c:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, r As Range


Set rng = Intersect(Target, [C8:C3000])

If rng Is Nothing Then Exit Sub

Application.EnableEvents = False

For Each r In rng

If Trim$(r) <> "" Then

r(, 2) = [f1]

With r(, 4).Resize(, 2)

.Value = Array(Time, Date)

.NumberFormat = Array("h:mm:ss AM/PM", "mm/dd/yyyy")

End With

r(, 6).Resize(, 2) = Array([D2], [F2])

Else
r.Range("b1,d1:g1").ClearContents

End If

Next

Application.EnableEvents = True

ThisWorkbook.Save

End Sub

this is my main excel file
test4.xlsm
ABCDEFGHIJ
1Category:Packing OperatorShipment Plan Qty:
2ModelWeighing OperatorFinished Good Qty.: 
3Shipment Date:Shipment FreightGood Weight 
4Start Serial1End SerialNG Weight 
5Minimum Maximum Lacking 
6Excess 
7Box No. BIGBox No. SMALLWeightPacking OperatorSerial NumberTimeDateModelWeighing OperatorRemarks
8   
9   
10  
11  
12   
13   
14   
15   
MASTER COPY
Cell Formulas
RangeFormula
D5D5=IF((D2=""),"",INDEX(Validation!I2:I8,MATCH('MASTER COPY'!D2,Validation!F2:F7,0)))
F5F5=IF((D2=""),"",INDEX(Validation!J2:J8,MATCH('MASTER COPY'!D2,Validation!F2:F7,0)))
H2H2=COUNT(C8:C100384)
H3H3=H2-H4
H4H4=((COUNTIFS(C8:C100000,"<"&D5)+(COUNTIFS(C8:C100000,">"&F5))))
H5H5=((COUNTIFS(C8:C10001,"<"&D5)))
H6H6=((COUNTIFS(L8:L10003,">"&O5)))
A8:A15A8=IFERROR(IFS($D$2="HDROP-15",INDEX(Serial!$E$2:$E$25426,MATCH('MASTER COPY'!E8,Serial!$A$2:$A$25426,0)),$D$2="HDROP-14",INDEX(Serial!$E$2:$E$25426,MATCH('MASTER COPY'!E8,Serial!$A$2:$A$25426,0)),$D$2="IND-B",INDEX(Serial!$D$2:$D$25426,MATCH('MASTER COPY'!E8,Serial!$A$2:$A$25426,0)),OR($D$2="HDROP-FK1",$D$2="JD2100",$D$2="JD2000WH",$D$2="JD2000BK"),INDEX(Serial!$B$2:$B$25426,MATCH('MASTER COPY'!E8,Serial!$A$2:$A$25426,0)),$D$2="ZR-02",INDEX(Serial!$F$2:$F$25426,MATCH('MASTER COPY'!E8,Serial!$A$2:$A$25426,0))),"")
B8:B15B8=IFERROR(IFS(OR($D$2="HDROP-14",$D$2="HDROP-15"),INDEX(Serial!$C$2:$C$25426,MATCH('MASTER COPY'!E8,Serial!$A$2:$A$25426,0))),"")
E7E7=IF(OR(D1="Option",D1="Harness"),"Item Count","Serial Number")
E8E8=IF(C8="","",D4)
E9,E12:E15E9=IF(C9="","",E8+1)
Named Ranges
NameRefers ToCells
ACCList=Validation!$F$5:$F$7D5, F5
OPList=Validation!$F$3:$F$4D5, F5
SIBList=Validation!$F$2D5, F5
Cells with Conditional Formatting
CellConditionCell FormatStop If True
C8:C1048576Cell Value<$D$5textNO
C8:C1048576Cell Value>$F$5textNO
Cells with Data Validation
CellAllowCriteria
D1List=ManuList
D2List=INDIRECT(VLOOKUP($D$1,ManuLookUp,2,0) &"List")
D3Any value
F1:F2List=OFFSET(Validation!$A$2:$A$999267,0,0,COUNTA(Validation!$A$2:$A$198)-0,1)
F3List=Validation!$C$10:$C$14


and my serial sheet is;
test4.xlsm
ABCDEF
1Serial10pcs25pcs50pcs100 pcs250pcs
2111111
3211111
4311111
5411111
6511111
7611111
8711111
9811111
10911111
111011111
121121111
131221111
141321111
151421111
161521111
171621111
181721111
191821111
201921111
212021111
222131111
232231111
242331111
252431111
262531111
272632111
282732111
Serial
Cell Formulas
RangeFormula
D3:F27,B28:F28,B27,B23:C26,C3:C22,B13:B21,B3:B11D3=D2
A2A2='MASTER COPY'!D4
A3:A28A3=A2+1





hope you can help me.
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Sort by date Sort by votes
Replace your code for this:

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rng As Range, r As Range, f As Range
  Dim sh As Worksheet
  Dim col As String
  
  Set sh = Sheets("Serial")
  Set rng = Intersect(Target, [C8:C3000])
  If rng Is Nothing Then Exit Sub
  
  Application.EnableEvents = False
  For Each r In rng
    If Trim$(r) <> "" Then
      r(, 2) = [f1]
      With r(, 4).Resize(, 2)
        .Value = Array(Time, Date)
        .NumberFormat = Array("h:mm:ss AM/PM", "mm/dd/yyyy")
      End With
      r(, 6).Resize(, 2) = Array([D2], [F2])
      
      Set f = sh.Range("A:A").Find(Range("E" & r.Row).Value, , xlValues, xlWhole, , , False)
      If Not f Is Nothing Then
        Select Case Range("D2")
          Case "HDROP-15", "HDROP-14"
            Range("A" & r.Row).Value = sh.Range("E" & f.Row).Value
            Range("B" & r.Row).Value = sh.Range("C" & f.Row).Value
          Case "IND-B"
            Range("A" & r.Row).Value = sh.Range("D" & f.Row).Value
            Range("B" & r.Row).Value = ""
          Case "HDROP-FK1", "JD2100", "JD2000WH", "JD2000BK"
            Range("A" & r.Row).Value = sh.Range("B" & f.Row).Value
            Range("B" & r.Row).Value = ""
          Case "ZR-02"
            Range("A" & r.Row).Value = sh.Range("F" & f.Row).Value
            Range("B" & r.Row).Value = ""
        End Select
      End If
    Else
      r.Range("b1,d1:g1").ClearContents
      Range("A" & r.Row).Resize(, 2).ClearContents
    End If
  Next
  
  Application.EnableEvents = True
  ThisWorkbook.Save
End Sub


----- --
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --
 
Upvote 1
DanteAmor said:
Replace your code for this:

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rng As Range, r As Range, f As Range
  Dim sh As Worksheet
  Dim col As String
 
  Set sh = Sheets("Serial")
  Set rng = Intersect(Target, [C8:C3000])
  If rng Is Nothing Then Exit Sub
 
  Application.EnableEvents = False
  For Each r In rng
    If Trim$(r) <> "" Then
      r(, 2) = [f1]
      With r(, 4).Resize(, 2)
        .Value = Array(Time, Date)
        .NumberFormat = Array("h:mm:ss AM/PM", "mm/dd/yyyy")
      End With
      r(, 6).Resize(, 2) = Array([D2], [F2])
  
      Set f = sh.Range("A:A").Find(Range("E" & r.Row).Value, , xlValues, xlWhole, , , False)
      If Not f Is Nothing Then
        Select Case Range("D2")
          Case "HDROP-15", "HDROP-14"
            Range("A" & r.Row).Value = sh.Range("E" & f.Row).Value
            Range("B" & r.Row).Value = sh.Range("C" & f.Row).Value
          Case "IND-B"
            Range("A" & r.Row).Value = sh.Range("D" & f.Row).Value
            Range("B" & r.Row).Value = ""
          Case "HDROP-FK1", "JD2100", "JD2000WH", "JD2000BK"
            Range("A" & r.Row).Value = sh.Range("B" & f.Row).Value
            Range("B" & r.Row).Value = ""
          Case "ZR-02"
            Range("A" & r.Row).Value = sh.Range("F" & f.Row).Value
            Range("B" & r.Row).Value = ""
        End Select
      End If
    Else
      r.Range("b1,d1:g1").ClearContents
      Range("A" & r.Row).Resize(, 2).ClearContents
    End If
  Next
 
  Application.EnableEvents = True
  ThisWorkbook.Save
End Sub


----- --
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --
Click to expand...
Hi good morning,
Thank you for your answer. The column A and B does not work. sorry my bad for lacking of information.
A and B column is triggered if a serial number is encoded on column E. i think the code needs trigger. Note that if column E is empty adjacent Column A and B is empty.
In my Main excel i should remove the fomulas of column A and B. so that vba codes is the one responsible for index matching that should be getting from sheet "SERIAL"
Thank you for finding solution. Love you Guys. Hope you can help me.
 
Last edited:
Upvote 0
cooleomter said:
Hi good morning,
Thank you for your answer. The column A and B does not work. sorry my bad for lacking of information.
A and B column is triggered if a serial number is encoded on column E. i think the code needs trigger. Note that if column E is empty adjacent Column A and B is empty.
In my Main excel i should remove the fomulas of column A and B. so that vba codes is the one responsible for index matching that should be getting from sheet "SERIAL"
Thank you for finding solution. Love you Guys. Hope you can help me.
Click to expand...
Hi good morning,
Thank you for your answer. The column A and B does not work. sorry my bad for lacking of information.
A and B column is triggered if a serial number is encoded on column E. i think the code needs trigger. Note that if column E is empty adjacent Column A and B is empty.
In my Main excel i should remove the fomulas of column A and B. so that vba codes is the one responsible for index matching that should be getting from sheet "SERIAL"
so that if Column C(independent column) has value column D,F,G,H,and I, has value through vba code. Then if column E (independent column) has value column A and B has value through VBA code. Note that the COlumn B has value only if certain TEXT (model in D2) is trigered if not it is empty.
Thank you for finding solution. Love you Guys. Hope you can help me.
 
Upvote 0
DanteAmor said:
Replace your code for this:

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rng As Range, r As Range, f As Range
  Dim sh As Worksheet
  Dim col As String
 
  Set sh = Sheets("Serial")
  Set rng = Intersect(Target, [C8:C3000])
  If rng Is Nothing Then Exit Sub
 
  Application.EnableEvents = False
  For Each r In rng
    If Trim$(r) <> "" Then
      r(, 2) = [f1]
      With r(, 4).Resize(, 2)
        .Value = Array(Time, Date)
        .NumberFormat = Array("h:mm:ss AM/PM", "mm/dd/yyyy")
      End With
      r(, 6).Resize(, 2) = Array([D2], [F2])
     
      Set f = sh.Range("A:A").Find(Range("E" & r.Row).Value, , xlValues, xlWhole, , , False)
      If Not f Is Nothing Then
        Select Case Range("D2")
          Case "HDROP-15", "HDROP-14"
            Range("A" & r.Row).Value = sh.Range("E" & f.Row).Value
            Range("B" & r.Row).Value = sh.Range("C" & f.Row).Value
          Case "IND-B"
            Range("A" & r.Row).Value = sh.Range("D" & f.Row).Value
            Range("B" & r.Row).Value = ""
          Case "HDROP-FK1", "JD2100", "JD2000WH", "JD2000BK"
            Range("A" & r.Row).Value = sh.Range("B" & f.Row).Value
            Range("B" & r.Row).Value = ""
          Case "ZR-02"
            Range("A" & r.Row).Value = sh.Range("F" & f.Row).Value
            Range("B" & r.Row).Value = ""
        End Select
      End If
    Else
      r.Range("b1,d1:g1").ClearContents
      Range("A" & r.Row).Resize(, 2).ClearContents
    End If
  Next
 
  Application.EnableEvents = True
  ThisWorkbook.Save
End Sub


----- --
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --
Click to expand...
Hi good morning,
Thank you for your answer. The column A and B does not work. sorry my bad for lacking of information.
A and B column is triggered if a serial number is encoded on column E. i think the code needs trigger. Note that if column E is empty adjacent Column A and B is empty.
In my Main excel i should remove the fomulas of column A and B. so that vba codes is the one responsible for index matching that should be getting from sheet "SERIAL"
so that if Column C(independent column) has value column D,F,G,H,and I, has value through vba code. Then if column E (independent column) has value column A and B has value through VBA code. Note that the COlumn B has value only if certain TEXT (model in D2) is trigered if not it is empty.
Thank you for finding solution. Love you Guys. Hope you can help me.
 
Upvote 0
DanteAmor said:
Replace your code for this:

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rng As Range, r As Range, f As Range
  Dim sh As Worksheet
  Dim col As String
 
  Set sh = Sheets("Serial")
  Set rng = Intersect(Target, [C8:C3000])
  If rng Is Nothing Then Exit Sub
 
  Application.EnableEvents = False
  For Each r In rng
    If Trim$(r) <> "" Then
      r(, 2) = [f1]
      With r(, 4).Resize(, 2)
        .Value = Array(Time, Date)
        .NumberFormat = Array("h:mm:ss AM/PM", "mm/dd/yyyy")
      End With
      r(, 6).Resize(, 2) = Array([D2], [F2])
     
      Set f = sh.Range("A:A").Find(Range("E" & r.Row).Value, , xlValues, xlWhole, , , False)
      If Not f Is Nothing Then
        Select Case Range("D2")
          Case "HDROP-15", "HDROP-14"
            Range("A" & r.Row).Value = sh.Range("E" & f.Row).Value
            Range("B" & r.Row).Value = sh.Range("C" & f.Row).Value
          Case "IND-B"
            Range("A" & r.Row).Value = sh.Range("D" & f.Row).Value
            Range("B" & r.Row).Value = ""
          Case "HDROP-FK1", "JD2100", "JD2000WH", "JD2000BK"
            Range("A" & r.Row).Value = sh.Range("B" & f.Row).Value
            Range("B" & r.Row).Value = ""
          Case "ZR-02"
            Range("A" & r.Row).Value = sh.Range("F" & f.Row).Value
            Range("B" & r.Row).Value = ""
        End Select
      End If
    Else
      r.Range("b1,d1:g1").ClearContents
      Range("A" & r.Row).Resize(, 2).ClearContents
    End If
  Next
 
  Application.EnableEvents = True
  ThisWorkbook.Save
End Sub


----- --
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --
Click to expand...
Hi let me explain. Column A is for Big box number, COlumn B is for small box. There are models that has small box (25 pcs qty items inside)and this small (4 pieces) is inserted to big box to create 100 qty of items. Now the tricky part is there are models that is directly inserted to big box making the the column B not needed any more and should be left empty or blank cell.
 
Upvote 0
DanteAmor said:
Replace your code for this:

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rng As Range, r As Range, f As Range
  Dim sh As Worksheet
  Dim col As String
 
  Set sh = Sheets("Serial")
  Set rng = Intersect(Target, [C8:C3000])
  If rng Is Nothing Then Exit Sub
 
  Application.EnableEvents = False
  For Each r In rng
    If Trim$(r) <> "" Then
      r(, 2) = [f1]
      With r(, 4).Resize(, 2)
        .Value = Array(Time, Date)
        .NumberFormat = Array("h:mm:ss AM/PM", "mm/dd/yyyy")
      End With
      r(, 6).Resize(, 2) = Array([D2], [F2])
     
      Set f = sh.Range("A:A").Find(Range("E" & r.Row).Value, , xlValues, xlWhole, , , False)
      If Not f Is Nothing Then
        Select Case Range("D2")
          Case "HDROP-15", "HDROP-14"
            Range("A" & r.Row).Value = sh.Range("E" & f.Row).Value
            Range("B" & r.Row).Value = sh.Range("C" & f.Row).Value
          Case "IND-B"
            Range("A" & r.Row).Value = sh.Range("D" & f.Row).Value
            Range("B" & r.Row).Value = ""
          Case "HDROP-FK1", "JD2100", "JD2000WH", "JD2000BK"
            Range("A" & r.Row).Value = sh.Range("B" & f.Row).Value
            Range("B" & r.Row).Value = ""
          Case "ZR-02"
            Range("A" & r.Row).Value = sh.Range("F" & f.Row).Value
            Range("B" & r.Row).Value = ""
        End Select
      End If
    Else
      r.Range("b1,d1:g1").ClearContents
      Range("A" & r.Row).Resize(, 2).ClearContents
    End If
  Next
 
  Application.EnableEvents = True
  ThisWorkbook.Save
End Sub


----- --
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --
Click to expand...
sorry ... my bad my excel file was dis abling the macro thats why your code did not work... its working now.. thak you so much
 
Upvote 1
DanteAmor said:
Replace your code for this:

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rng As Range, r As Range, f As Range
  Dim sh As Worksheet
  Dim col As String
 
  Set sh = Sheets("Serial")
  Set rng = Intersect(Target, [C8:C3000])
  If rng Is Nothing Then Exit Sub
 
  Application.EnableEvents = False
  For Each r In rng
    If Trim$(r) <> "" Then
      r(, 2) = [f1]
      With r(, 4).Resize(, 2)
        .Value = Array(Time, Date)
        .NumberFormat = Array("h:mm:ss AM/PM", "mm/dd/yyyy")
      End With
      r(, 6).Resize(, 2) = Array([D2], [F2])
     
      Set f = sh.Range("A:A").Find(Range("E" & r.Row).Value, , xlValues, xlWhole, , , False)
      If Not f Is Nothing Then
        Select Case Range("D2")
          Case "HDROP-15", "HDROP-14"
            Range("A" & r.Row).Value = sh.Range("E" & f.Row).Value
            Range("B" & r.Row).Value = sh.Range("C" & f.Row).Value
          Case "IND-B"
            Range("A" & r.Row).Value = sh.Range("D" & f.Row).Value
            Range("B" & r.Row).Value = ""
          Case "HDROP-FK1", "JD2100", "JD2000WH", "JD2000BK"
            Range("A" & r.Row).Value = sh.Range("B" & f.Row).Value
            Range("B" & r.Row).Value = ""
          Case "ZR-02"
            Range("A" & r.Row).Value = sh.Range("F" & f.Row).Value
            Range("B" & r.Row).Value = ""
        End Select
      End If
    Else
      r.Range("b1,d1:g1").ClearContents
      Range("A" & r.Row).Resize(, 2).ClearContents
    End If
  Next
 
  Application.EnableEvents = True
  ThisWorkbook.Save
End Sub


----- --
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --
Click to expand...
Hi Sir,

I have a problem with the code. the code sometimes works and some times don't. only on the A and B column.
A and B suppose to be blank and nothing is encoded..
 
Upvote 0
this is the correction of code.

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, r As Range, f As Range
Dim sh As Worksheet
Dim col As String

Set sh = Sheets("Serial")
Set rng = Intersect(Target, [C8:C3000])
If rng Is Nothing Then Exit Sub

For Each r In rng
If Trim$(r) <> "" Then
r(, 2) = [f1]
With r(, 4).Resize(, 2)
.Value = Array(Time, Date)
.NumberFormat = Array("h:mm:ss AM/PM", "mm/dd/yyyy")
End With
r(, 6).Resize(, 2) = Array([D2], [F2])

ThisWorkbook.save "To activate Column E formula and other formulas

Set f = sh.Range("A:A").Find(Range("E" & r.Row).Value, , xlValues, xlWhole, , , False)
If Not f Is Nothing Then
Select Case Range("D2")
Case "HDROP-15", "HDROP-14"
Range("A" & r.Row).Value = sh.Range("E" & f.Row).Value
Range("B" & r.Row).Value = sh.Range("C" & f.Row).Value
Case "IND-B"
Range("A" & r.Row).Value = sh.Range("D" & f.Row).Value
Range("B" & r.Row).Value = ""
Case "HDROP-FK1", "JD2100", "JD2000WH", "JD2000BK"
Range("A" & r.Row).Value = sh.Range("B" & f.Row).Value
Range("B" & r.Row).Value = ""
Case "ZR-02"
Range("A" & r.Row).Value = sh.Range("F" & f.Row).Value
Range("B" & r.Row).Value = ""
End Select
End If
Else
r.Range("b1,d1:g1").ClearContents
Range("A" & r.Row).Resize(, 2).ClearContents
End If
Next

ThisWorkbook.Save
End Sub


i have to remove the
Application.EnableEvents = False
and
Application.EnableEvents = True
since Column "E" is formula which will not calculate if application.enableevents is OFF.
the Case code shall detect blank on the Column "E" thats why it results blank to Column "A" and "B".
since my excel formulas will be active if saved. i place ThisWorkbook.save before Case code.

thank you for your code.
Godbless and Be Healthy
 
Upvote 1
I put my updated code:

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rng As Range, r As Range, f As Range
  Dim sh As Worksheet
  Dim col As String
 
  Set sh = Sheets("Serial")
  Set rng = Intersect(Target, [C8:C3000])
  If rng Is Nothing Then Exit Sub
 
  For Each r In rng
    If Trim$(r) <> "" Then
      r(, 2) = [f1]
      With r(, 4).Resize(, 2)
        .Value = Array(Time, Date)
        .NumberFormat = Array("h:mm:ss AM/PM", "mm/dd/yyyy")
      End With
      r(, 6).Resize(, 2) = Array([D2], [F2])
    
      ThisWorkbook.Save "To activate Column E formula and other formulas"
    
      Set f = sh.Range("A:A").Find(Range("E" & r.Row).Value, , xlValues, xlWhole, , , False)
      If Not f Is Nothing Then
        Select Case Range("D2")
          Case "HDROP-15", "HDROP-14"
            Range("A" & r.Row).Value = sh.Range("E" & f.Row).Value
            Range("B" & r.Row).Value = sh.Range("C" & f.Row).Value
          Case "IND-B"
            Range("A" & r.Row).Value = sh.Range("D" & f.Row).Value
            Range("B" & r.Row).Value = ""
          Case "HDROP-FK1", "JD2100", "JD2000WH", "JD2000BK"
            Range("A" & r.Row).Value = sh.Range("B" & f.Row).Value
            Range("B" & r.Row).Value = ""
          Case "ZR-02"
            Range("A" & r.Row).Value = sh.Range("F" & f.Row).Value
            Range("B" & r.Row).Value = ""
        End Select
      End If
    Else
      r.Range("b1,d1:g1").ClearContents
      Range("A" & r.Row).Resize(, 2).ClearContents
    End If
  Next
 
  ThisWorkbook.Save
End Sub

Note Code Tag:
In future please use code tags when posting code.
How to Post Your VBA Code it makes your code easier to read and copy and it also maintains VBA formatting.

----- --
Let me know if you need anything else.
Sincerely
Dante Amor
----- --



😇
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

U
  • Question
Dynamic Macro for INDEX/MATCH Formula
Replies
1
Views
236
StephenCrump
S
P
  • Solved
VBA Match data, find mismatch data and copy data to validation sheet. Not working correctly.
2
Replies
16
Views
1K
pawcoyote
P
O
  • Question
Match with variable lookup array
Replies
1
Views
201
Oras78
O
Asbestos_Jen
  • Question
Compare multiple parameters of samples to reference values (Excel 2007)
Replies
2
Views
247
Asbestos_Jen
Asbestos_Jen
Drrellik
  • Solved
VBA to complete Index/Match with 2 criteria
2
Replies
10
Views
279
Alex Blakenburg
A

Forum statistics

Threads
1,221,418
Messages
6,159,791
Members
451,589
Latest member
Harold14

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