0

I would like to know how can I make this code work for cells H13:H24 and B13:B24 instead of H13 and B13 only ? (While all the other conditions remain the same)

Basically to multiply this code 10 times or x times without writing it again 10 times and replacing manually H13 and B13 for each line.

I will use this code for 400 different B13:B24 which I have in a different column and I wrote the values manually inside the code (The code below has only 3 of them). If you have any idea how to select the values from that column also, instead of writing them inside the code, it would be way better.

This is the code:

Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("H14")) Is Nothing And (Range("B14") = "32849") Then
        For i = 7 To Columns.Count
            If Worksheets("Predare").Cells(1, i).EntireColumn.Hidden = False Then
                Worksheets("Predare").Range("G4").Offset(0, i - 7) = Worksheets("Predare").Range("G4").Offset(0, i - 7).Value + Target.Value
                GoTo MyEnd
            End If
        Next i
    End If
    If Not Intersect(Target, Range("H14")) Is Nothing And (Range("B14") = "79504") Then
        For i = 7 To Columns.Count
            If Worksheets("Predare").Cells(1, i).EntireColumn.Hidden = False Then
                 Worksheets("Predare").Range("G5").Offset(0, i - 7) = Worksheets("Predare").Range("G5").Offset(0, i - 7).Value + Target.Value
                GoTo MyEnd
            End If
        Next i
    End If
    If Not Intersect(Target, Range("H14")) Is Nothing And (Range("B14") = "10486") Then
        For i = 7 To Columns.Count
            If Worksheets("Predare").Cells(1, i).EntireColumn.Hidden = False Then
                 Worksheets("Predare").Range("G6").Offset(0, i - 7) = Worksheets("Predare").Range("G6").Offset(0, i - 7).Value + Target.Value
                GoTo MyEnd
            End If
        Next i
    End If
MyEnd:
End Sub

I've tried to use a named range and also H13:H24 inside the range definition but I'm probably doing something wrong since it doesn't work.

Thank you very much if you have any idea

=================================================

EDIT:

I will add 2 images of my actual excel file to be able to explain exactly what I need. Please look at images 1 and 2 (which represent 2 sheets in the same excel file):

Sheet Predare

Sheet Proces verbal de predare

What I need the code to do is this:

If 'Proces verbal de predare'!B14:B25 matches the value of any of the cells(so not in the same order) from sheet Predare!B4:B500, then whatever value I write inside 'Proces verbal de predare'!H14:H25, do :

Worksheets("Predare").Range("G4").Offset(0, i - 7) = Worksheets("Predare").Range("G4").Offset(0, i - 7).Value + Target.Value

But Instead of G4, I need it to be Gn, with n = the matching row of the code written inside 'Proces verbal de predare'!B14:B25

1
  • If you want to see how to do this, please check the last comment of Justin Doward's answer. Jun 16 at 19:16
0

This is the final code that solved the issue:

Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("H14:H25")) Is Nothing Then
Dim ws2 As Worksheet: Set ws2 = Sheet2
Dim ws3 As Worksheet: Set ws3 = Sheet3
x = Application.Match(Range("B" & Target.Row), ws2.Range("B4:B500"), 0)
If IsNumeric(x) Then
For i = 7 To Columns.Count
If ws2.Cells(1, i).EntireColumn.Hidden = False Then
ws2.Range("G" & x + 3).Offset(0, i - 7) = ws2.Range("G" & x + 3).Offset(0, i - 7).Value2 & CStr(Target.Value)
GoTo MyEnd
End If
Next i
End If
End If
MyEnd:
End Sub

Not 100% sure if this is what you are after so get back if it is not:

Option Base 1

    Sub Worksheet_Change(ByVal Target As Range)
        If Not Intersect(Target, Range("H13:H24")) Is Nothing Then
        Dim MyArr1, MyArr2
        MyArr1 = Application.Transpose(Range("A13:A24")) ' Array of constants being checked
        MyArr2 = Application.Transpose(Range("B13:B24")) ' Array of variable values
            If MyArr1(Target.Row - 12) = MyArr2(Target.Row - 12) Then
                For i = 11 To Columns.Count
                    If Cells(1, i).EntireColumn.Hidden = False Then
                        Range("K4").Offset(0, i - 11) = Range("K4").Offset(0, i - 11).Value + Target.Text
                        GoTo MyEnd
                    End If
                Next i
            End If
        End If
    MyEnd:
    End Sub

NB: you put the text that you want to match in A13:A24 (i.e."10486" etc), you can hide this range anywhere and adjust to allow for the row. Option Base 1 needs to go at the top of the page, alternatively you can remove this line but the arrays will start from 0 rather than 1. You do not actually need to use the arrays if you want to modify to work directly from the sheet. Let me know how it goes.

10
  • Hello Justin, Is there a way I can talk to you in private ? I feel like you are a great man that can help me fix this entire thing but I can't explain it right in the comments here. I've tried the code you gave me now but It doesn't work. I probably do something wrong. Jun 16 at 11:44
  • Ok, I've checked the code and It works but it's not what I need from it. It's close though. Can I contact you some other way ? Jun 16 at 12:01
  • Hello Victor, sorry the code is not quite right. I think you would be better off starting a thread with an example sheet with the code in place and the expected result at Ozgrid (ozgrid.com/forum/index.php?board/75-excel-vba-macros). Don't forget to read the rules and put a link to here saying you have cross posted, you will find the moderators there will help you quite quickly so long as you tag your code correctly and follow the basic rules, If you are after a lot of help rather than pointers I think another forum is probably the way to go. Jun 16 at 12:18
  • I am also on there and you can message me to let me know when the thread is up. Jun 16 at 12:18
  • Hello Justin, I've edited the current post with more details. Please take a look at the modifications if you may. I will also start a thread on the website you mentioned if you think it helps. I saw that there is chat on the other website, so I will message you there. Thank you so much for all your work Jun 16 at 12:24

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.