Developer technologies | Visual Basic for Applications
An implementation of Visual Basic that is built into Microsoft products.
Macros crashed please help
![](data:image/svg+xml, %3Csvg xmlns='http://www.w3.org/2000/svg' height='64' class='font-weight-bold' style='font: 600 30.11764705882353px "SegoeUI", Arial' width='64'%3E%3Ccircle fill='hsl(105.60000000000001, 2%, 20%)' cx='32' cy='32' r='32' /%3E%3Ctext x='50%25' y='55%25' dominant-baseline='middle' text-anchor='middle' fill='%23FFF' %3EJM%3C/text%3E%3C/svg%3E)
Jay McClure
21
Reputation points
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cVal As String
Dim pVal As String
Dim eVal As String
Dim rN As Integer
Dim rC As Integer
Dim cRw As String
Dim cV1 As String
Dim cV2 As String
Dim uCT As Integer 'Total unit count
Dim uCL As Integer 'Load unit count
If Not Intersect(Target, Range("D3:D62")) Is Nothing Then
cVal = ActiveCell.Value
'For x = 3 To 62
rN = ActiveCell.Row
rC = ActiveCell.Column
c1 = Range("B1").Value
cV1 = Range("B" & rN).Value
cV2 = Range("B" & rN - 1).Value
uCT = Range("C1").Value
If cV1 = "" Then
rN = rN - 1
'ElseIf cV2 = "" Then
End If
cVal = Range("D" & rN).Value 'Load Type
If c1 = "" Or IsNull(c1) Then
If rN = 2 Then
Exit Sub
Else:
'rN = rN - 1
uCL = Range("C" & rN).Value 'Load Unit Count
pVal = Range("B" & rN).Value 'PO Number
cVal = Range("D" & rN).Value 'Load Type
End If
ElseIf rC = 5 Then
'rN = rN - 1
pVal = " " & Range("B" & rN).Value
cVal = Range("D" & rN).Value
uCL = Range("C" & rN).Value 'Load Unit Count
Else:
pVal = " " & Range("B" & rN).Value
uCL = Range("C" & rN).Value 'Load Unit Count
End If
eVal = ""
'If cVal = "" And pVal = " " Then
' Exit Sub
If Range("A1").Value = "C" Then
Exit Sub
ElseIf InStr(Range("B1"), Range("C" & rN)) = 1 Then
Exit Sub
' ElseIf rC = 3 And ActiveCell.Row = rN Then
' Exit Sub
ElseIf cVal = "" Then
Range("B1").Select
ActiveCell.Characters(Len(c1) + 1).Insert pVal
colr = Range("H" & rN).Value
Range("B1").Characters(colr, 9).Font.Color = vbBlack
Range("C1").Value = uCT + uCL
Cells(rN, rC).Select
ElseIf cVal = "H" Or cVal = "h" Then
Range("B1").Select
ActiveCell.Characters(Len(c1) + 1).Insert pVal
colr = Range("H" & rN).Value
Range("B1").Characters(colr, 9).Font.Color = vbRed
Range("C1").Value = uCT + uCL
Cells(rN, rC).Select
ElseIf cVal = "B" Or cVal = "b" Then
Range("B1").Select
ActiveCell.Characters(Len(c1) + 1).Insert pVal
colr = Range("H" & rN).Value
Range("B1").Characters(colr, 9).Font.FontStyle = "Bold"
Range("B1").Characters(colr, 9).Font.Color = vbBlack
Range("C1").Value = uCT + uCL
Cells(rN, rC).Select
ElseIf cVal = "HB" Or cVal = "hB" Or cVal = "hb" Or cVal = "Hb" Then
colr = Range("H" & rN).Value
Range("B1").Select
ActiveCell.Characters(Len(c1)).Insert pVal
Range("B1").Characters(colr, 9).Font.Color = vbRed
Range("B1").Characters(colr, 9).Font.FontStyle = "Bold"
Range("C1").Value = uCT + uCL
Cells(rN, rC).Select
ElseIf cVal = "M" Or cVal = "m" Then
Range("B1").Select
ActiveCell.Characters(Len(c1) + 1).Insert pVal
colr = Range("H" & rN).Value
Range("B1").Characters(colr, 9).Font.Color = vbBlue
Range("C1").Value = uCT + uCL
Cells(rN, rC).Select
ElseIf cVal = "P" Or cVal = "p" Then
Range("B1").Select
ActiveCell.Characters(Len(c1) + 1).Insert pVal
colr = Range("H" & rN).Value
Range("B1").Characters(colr, 9).Font.Color = RGB(204, 102, 255)
Range("C1").Value = uCT + uCL
Cells(rN, rC).Select
ElseIf cVal = "S" Or cVal = "s" Then
Range("B1").Select
ActiveCell.Characters(Len(c1) + 1).Insert pVal
colr = Range("H" & rN).Value
Range("B1").Characters(colr, 9).Font.Color = vbBlack
Range("C1").Value = uCT + uCL
Cells(rN, rC).Select
End If
cV1 = Range("B" & rN).Value
If cV1 <> "" Then
'rN = rN + 1
rC = 2
Cells(rN, rC).Select
End If
'Range("D" & rN).Select
'set formula here
'Next x
'If ActiveCell.Row <> rN Then Range("B" & rN + 1).Select
End If
'Cells(rN + 1, rC).Select
If Not Intersect(Target, Range("L3:L62")) Is Nothing Then
cVal = ActiveCell.Value
'For x = 3 To 62
rN = ActiveCell.Row
rC = ActiveCell.Column
c1 = Range("J1").Value 'PO's already listed
cV1 = Range("J" & rN).Value 'New PO to add to list
cV2 = Range("J" & rN - 1).Value 'PO Above current
uCT = Range("K1").Value
If cV1 = "" Then
rN = rN - 1
'ElseIf cV2 = "" Then
End If
cVal = Range("L" & rN).Value 'Load Type
If c1 = "" Or IsNull(c1) Then
If rN = 2 Then
Exit Sub
Else:
uCL = Range("K" & rN).Value 'Load Unit Count
pVal = Range("J" & rN).Value 'PO Number
cVal = Range("L" & rN).Value 'Load Type
End If
ElseIf rC = 13 Then
'rN = rN - 1
uCL = Range("K" & rN).Value 'Load Unit Count
pVal = " " & Range("J" & rN).Value
cVal = Range("L" & rN).Value
Else:
uCL = Range("K" & rN).Value 'Load Unit Count
pVal = " " & Range("J" & rN).Value
End If
eVal = ""
'If cVal = "" And pVal = " " Then
' Exit Sub
If Range("L1").Value = "C" Then
Exit Sub
ElseIf InStr(Range("J1"), Range("J" & rN)) = 1 Then
Exit Sub
' ElseIf rC = 3 And ActiveCell.Row = rN Then
' Exit Sub
ElseIf cVal = "" Then
Range("J1").Select
ActiveCell.Characters(Len(c1) + 1).Insert pVal
colr = Range("H" & rN).Value
Range("J1").Characters(colr, 9).Font.Color = vbBlack
Range("K1").Value = uCT + uCL
Cells(rN, rC).Select
ElseIf cVal = "H" Or cVal = "h" Then
Range("J1").Select
ActiveCell.Characters(Len(c1) + 1).Insert pVal
colr = Range("H" & rN).Value
Range("J1").Characters(colr, 9).Font.Color = vbRed
Range("K1").Value = uCT + uCL
Cells(rN, rC).Select
ElseIf cVal = "B" Or cVal = "b" Then
Range("J1").Select
ActiveCell.Characters(Len(c1) + 1).Insert pVal
colr = Range("H" & rN).Value
Range("J1").Characters(colr, 9).Font.FontStyle = "Bold"
Range("J1").Characters(colr, 9).Font.Color = vbBlack
Range("K1").Value = uCT + uCL
Cells(rN, rC).Select
ElseIf cVal = "HB" Or cVal = "hB" Or cVal = "hb" Or cVal = "Hb" Then
colr = Range("H" & rN).Value
Range("J1").Select
ActiveCell.Characters(Len(c1)).Insert pVal
Range("J1").Characters(colr, 9).Font.Color = vbRed
Range("J1").Characters(colr, 9).Font.FontStyle = "Bold"
Range("K1").Value = uCT + uCL
Cells(rN, rC).Select
ElseIf cVal = "M" Or cVal = "m" Then
Range("J1").Select
ActiveCell.Characters(Len(c1) + 1).Insert pVal
colr = Range("H" & rN).Value
Range("J1").Characters(colr, 9).Font.Color = vbBlue
Range("K1").Value = uCT + uCL
Cells(rN, rC).Select
ElseIf cVal = "P" Or cVal = "p" Then
Range("J1").Select
ActiveCell.Characters(Len(c1) + 1).Insert pVal
colr = Range("H" & rN).Value
Range("J1").Characters(colr, 9).Font.Color = RGB(204, 102, 255)
Range("K1").Value = uCT + uCL
Cells(rN, rC).Select
ElseIf cVal = "S" Or cVal = "s" Then
Range("J1").Select
ActiveCell.Characters(Len(c1) + 1).Insert pVal
colr = Range("H" & rN).Value
Range("J1").Characters(colr, 9).Font.Color = vbBlack
Range("K1").Value = uCT + uCL
Cells(rN, rC).Select
End If
cV1 = Range("J" & rN).Value
If cV1 <> "" Then
'rN = rN + 1
rC = 13
Cells(rN, rC).Select
End If
'Range("D" & rN).Select
'set formula here
'Next x
'If ActiveCell.Row <> rN Then Range("B" & rN + 1).Select
End If
End Sub
my apologies for the long code
Thanks in advance
Developer technologies | Visual Basic for Applications
-
Reza Aghaei 4,996 Reputation points Volunteer Moderator2022-07-27T18:54:23.55+00:00 It's hard to answer the question in the current format. Please consider the following improvements on the question:
- Do not post the same question multiple times.
- Use the code blocks feature to format the code and make the question more readable.
- Add debugging info, error code, error description, where you get error, expected behavior and etc.
- Read How to write a quality question.
-
Jay McClure 21 Reputation points
2022-07-27T19:11:21.007+00:00 Hi,
I did not write this twice it's just the code is very long.
thanks -
Reza Aghaei 4,996 Reputation points Volunteer Moderator
2022-07-27T19:49:10.74+00:00 I see you have already deleted the other post. Never mind. Just wanted to share some tips to help you improve the quality of your question to get have more chance to receive an answer .
Sign in to comment
Sign in to answer