I'm pretty amateur when it comes to VBA, but not to code wrangling on the whole, but this issue has me beating my head against a wall.
I have a page set up to use Worksheet_Change(ByVal Target As Range) in order to propagate additional cells in the row with different formulae to provide information about a part number entered into column A.
Worksheet_Change(ByVal Target As Range) is something new I'm adding to previously existing code to make it look fancier and bury the formulae in the VBA instead of the cells themselves (like I did in my previous version).
(Aside: The formulae aren't the problem and I don't have unique ones plugged in for all the fields yet, I'm trying to get the Sort Button working first)
I have a button set up on the Page that is supposed to combine like Part Numbers (from Column A) and sum the totals of them (from column B) and then sort them alphabetically and spit them back out into two different places.
This button worked perfectly on my last version, but now I'm having a hang-up using it in conjunction with Worksheet_Change(ByVal Target As Range).
Any assistance would be appreciated. I'm not looking to make "pretty code" yet. I'm just trying to understand what I'm doing/doing wrong as I try to implement my goals.
I have a few ideas as to what is hanging up and why, but it'll save me some time and headache if someone can help me out.
I believe the following should be all the relevant code you should need:
I have a page set up to use Worksheet_Change(ByVal Target As Range) in order to propagate additional cells in the row with different formulae to provide information about a part number entered into column A.
Worksheet_Change(ByVal Target As Range) is something new I'm adding to previously existing code to make it look fancier and bury the formulae in the VBA instead of the cells themselves (like I did in my previous version).
(Aside: The formulae aren't the problem and I don't have unique ones plugged in for all the fields yet, I'm trying to get the Sort Button working first)
I have a button set up on the Page that is supposed to combine like Part Numbers (from Column A) and sum the totals of them (from column B) and then sort them alphabetically and spit them back out into two different places.
This button worked perfectly on my last version, but now I'm having a hang-up using it in conjunction with Worksheet_Change(ByVal Target As Range).
Any assistance would be appreciated. I'm not looking to make "pretty code" yet. I'm just trying to understand what I'm doing/doing wrong as I try to implement my goals.
I have a few ideas as to what is hanging up and why, but it'll save me some time and headache if someone can help me out.
I believe the following should be all the relevant code you should need:
VBA Code:
'Option Explicit requires me to define my variables
Option Explicit
'Define the variables globally
Dim LR As Long, TR As Long, LR2 As Long, LR3 As Long, i As Long, j As Long
Dim ws1 As Worksheet, ws As Worksheet, ws2 As Worksheet
Dim ws1Name As String, ws2Name As String
Dim Target As Range
Dim myFormula As String
Private Sub Worksheet_Change(ByVal Target As Range)
LR = Me.Cells(Rows.Count, 1).End(xlUp).Row
TR = Target.Row
Application.EnableEvents = False
Application.ScreenUpdating = False
If Not Intersect(Target, Range("A5:A" & LR + 1)) Is Nothing Then
With Range("A5:Q5000")
With .Borders(xlInsideHorizontal)
.LineStyle = xlNone
End With
With .Borders(xlInsideVertical)
.LineStyle = xlNone
End With
.BorderAround LineStyle:=xlNone
End With
LR = Me.Cells(Rows.Count, 1).End(xlUp).Row
With Range("A5:P" & LR + 1)
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = xlColorIndexAutomatic
.Weight = xlThin
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = xlColorIndexAutomatic
.Weight = xlThin
End With
.BorderAround LineStyle:=xlContinuous, Weight:=xlThick, ColorIndex:=xlColorIndexAutomatic
End With
If Target.Value <> "" Then '<---------------------PROBLEM Line according to the Debugger, see Comment Block about my issue further down in the code
Worksheets("Entry Page").Range("C" & TR).Formula = "=IFERROR(IF(INDEX(INDIRECT(""Database!$B$2:$B$""&COUNTA(Database!$A$1:$A5000)),MATCH(A" & TR & ",INDIRECT(""Database!$B$2:$B$""&COUNTA(Database!$A$1:$A5000)),0))=A" & TR & ",OFFSET(INDEX(INDIRECT(""Database!$B$2:$B$""&COUNTA(Database!$A$1:$A5000)),MATCH(A" & TR & ",INDIRECT(""Database!$B$2:$B$""&COUNTA(Database!$A$1:$A5000)),0)),0,1)),""NOT IN DATABASE"")"
Worksheets("Entry Page").Range("D" & TR).Formula = "=IFERROR(IF(OFFSET(INDEX(INDIRECT(""Database!$B$2:$B$""&COUNTA(Database!$A$1:$A5000)),MATCH(A" & TR & ",INDIRECT(""Database!$B$2:$B$""&COUNTA(Database!$A$1:$A5000)),0)),0,30)=""N"",""NO SDS"",""YES SDS""),""NOT IN DATABASE"")"
Worksheets("Entry Page").Range("E" & TR).Formula = "=IFERROR(IF(OFFSET(INDEX(INDIRECT(""Database!$B$2:$B$""&COUNTA(Database!$A$1:$A5000)),MATCH(A" & TR & ",INDIRECT(""Database!$B$2:$B$""&COUNTA(Database!$A$1:$A5000)),0)),0,30)=""N"",""NO SDS"",""YES SDS""),""NOT IN DATABASE"")"
Worksheets("Entry Page").Range("F" & TR).Formula = "=IFERROR(IF(OFFSET(INDEX(INDIRECT(""Database!$B$2:$B$""&COUNTA(Database!$A$1:$A5000)),MATCH(A5,INDIRECT(""Database!$B$2:$B$""&COUNTA(Database!$A$1:$A5000)),0)),0,33)="""",IF(H5=""N/A"",""N/A"",""NO SDS""),""YES SDS""),""NOT IN DATABASE"")"
Worksheets("Entry Page").Range("G" & TR).Formula = "=IFERROR(IF(OFFSET(INDEX(INDIRECT(""Database!$B$2:$B$""&COUNTA(Database!$A$1:$A5000)),MATCH(A5,INDIRECT(""Database!$B$2:$B$""&COUNTA(Database!$A$1:$A5000)),0)),0,33)="""",IF(H5=""N/A"",""N/A"",""NO SDS""),""YES SDS""),""NOT IN DATABASE"")"
Worksheets("Entry Page").Range("H" & TR).Formula = "=IFERROR(IF(OFFSET(INDEX(INDIRECT(""Database!$B$2:$B$""&COUNTA(Database!$A$1:$A5000)),MATCH(A5,INDIRECT(""Database!$B$2:$B$""&COUNTA(Database!$A$1:$A5000)),0)),0,33)="""",IF(H5=""N/A"",""N/A"",""NO SDS""),""YES SDS""),""NOT IN DATABASE"")"
Worksheets("Entry Page").Range("I" & TR).Formula = "=IFERROR(IF(OFFSET(INDEX(INDIRECT(""Database!$B$2:$B$""&COUNTA(Database!$A$1:$A5000)),MATCH(A5,INDIRECT(""Database!$B$2:$B$""&COUNTA(Database!$A$1:$A5000)),0)),0,33)="""",IF(H5=""N/A"",""N/A"",""NO SDS""),""YES SDS""),""NOT IN DATABASE"")"
Worksheets("Entry Page").Range("J" & TR).Formula = "=IFERROR(IF(OFFSET(INDEX(INDIRECT(""Database!$B$2:$B$""&COUNTA(Database!$A$1:$A5000)),MATCH(A5,INDIRECT(""Database!$B$2:$B$""&COUNTA(Database!$A$1:$A5000)),0)),0,33)="""",IF(H5=""N/A"",""N/A"",""NO SDS""),""YES SDS""),""NOT IN DATABASE"")"
Worksheets("Entry Page").Range("K" & TR).Formula = "=IFERROR(IF(OFFSET(INDEX(INDIRECT(""Database!$B$2:$B$""&COUNTA(Database!$A$1:$A5000)),MATCH(A5,INDIRECT(""Database!$B$2:$B$""&COUNTA(Database!$A$1:$A5000)),0)),0,33)="""",IF(H5=""N/A"",""N/A"",""NO SDS""),""YES SDS""),""NOT IN DATABASE"")"
Worksheets("Entry Page").Range("L" & TR).Formula = "=IFERROR(IF(OFFSET(INDEX(INDIRECT(""Database!$B$2:$B$""&COUNTA(Database!$A$1:$A5000)),MATCH(A5,INDIRECT(""Database!$B$2:$B$""&COUNTA(Database!$A$1:$A5000)),0)),0,33)="""",IF(H5=""N/A"",""N/A"",""NO SDS""),""YES SDS""),""NOT IN DATABASE"")"
Worksheets("Entry Page").Range("M" & TR).Formula = "=IFERROR(IF(OFFSET(INDEX(INDIRECT(""Database!$B$2:$B$""&COUNTA(Database!$A$1:$A5000)),MATCH(A5,INDIRECT(""Database!$B$2:$B$""&COUNTA(Database!$A$1:$A5000)),0)),0,33)="""",IF(H5=""N/A"",""N/A"",""NO SDS""),""YES SDS""),""NOT IN DATABASE"")"
Worksheets("Entry Page").Range("N" & TR).Formula = "=IFERROR(IF(OFFSET(INDEX(INDIRECT(""Database!$B$2:$B$""&COUNTA(Database!$A$1:$A5000)),MATCH(A5,INDIRECT(""Database!$B$2:$B$""&COUNTA(Database!$A$1:$A5000)),0)),0,33)="""",IF(H5=""N/A"",""N/A"",""NO SDS""),""YES SDS""),""NOT IN DATABASE"")"
Worksheets("Entry Page").Range("O" & TR).Formula = "=IFERROR(IF(OFFSET(INDEX(INDIRECT(""Database!$B$2:$B$""&COUNTA(Database!$A$1:$A5000)),MATCH(A5,INDIRECT(""Database!$B$2:$B$""&COUNTA(Database!$A$1:$A5000)),0)),0,33)="""",IF(H5=""N/A"",""N/A"",""NO SDS""),""YES SDS""),""NOT IN DATABASE"")"
Worksheets("Entry Page").Range("P" & TR).Formula = "=IFERROR(IF(OFFSET(INDEX(INDIRECT(""Database!$B$2:$B$""&COUNTA(Database!$A$1:$A5000)),MATCH(A5,INDIRECT(""Database!$B$2:$B$""&COUNTA(Database!$A$1:$A5000)),0)),0,33)="""",IF(H5=""N/A"",""N/A"",""NO SDS""),""YES SDS""),""NOT IN DATABASE"")"
Else
Worksheets("Entry Page").Range("B" & TR & ":P" & TR).Value = ""
End If
Else
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton1_Click()
'Cycle through all sheets until sheet with desired CodeName is found
For Each ws In ThisWorkbook.Worksheets
'Entry Page - permanently set as Sheet1
If ws.CodeName = "Sheet1" Then
ws1Name = ws.Name
End If
'ResultsPage
If ws.CodeName = "Sheet6" Then
ws2Name = ws.Name
End If
Next ws
'Turn off screen updating to stop screen flicker
Application.ScreenUpdating = False
'Select Worksheet
Worksheets(ws1Name).Select
Set ws1 = Worksheets(ws1Name)
With ws1
'Find the last used row in column 1 = "A"
LR = .Cells(Rows.Count, 1).End(xlUp).Row
'Use AdvancedFilter on range A5:A LR
' of range A5:A LR
'And, copy the unique values to T1
.Range("A4:A" & LR).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("T1"), Unique:=True
'Find the last row of column T = 20
LR2 = .Cells(Rows.Count, 20).End(xlUp).Row
'I find it easier to use R1C1 reference for filling a range with a formula
With .Range("U2:U" & LR2)
'The next .FormulaR1C1 translates to:
' =SUMPRODUCT(--($A$5:$A$LR=$T2),$B$5:$B$LR)
.FormulaR1C1 = "=SUMPRODUCT(--(R5C1:R" & LR & "C1=RC20),R5C2:R" & LR & "C2)"
'Change the formula to its value
.Value = .Value
'Format the borders and font size
With .Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlColorIndexAutomatic
End With
.Borders(xlEdgeRight).Weight = xlThick
.Font.Size = 8
End With
'Clear original data - ws1.Range("A5:B LR")
With ws1.Range("A5:B" & LR)
.ClearContents
End With
'Sort and then Copy ws1.Range("T2:U LR2") to ws1.Range("A5")
With ws1.Range("T2:U" & LR2)
'Sort Alphabetically
.Sort Key1:=Range("T2"), Order1:=xlAscending, Header:=xlNo
'Copy Sorted Range over to original columns
.Copy ws1.Range("A5")
End With
'Comment Block about my issue:
'It visually clears the original data fields, but throws an error before pasting anything into A5->
'Additionally, the propagated cells which should be going blank when
'the original data fields are cleared aren't getting cleared prior to the hangup
'It's throwing a Run-time error '13': Type mismatch error
'Is it because Target.Value needs to be a single cell and not several?
'can I put some code in to cycle through the range of cells to be pasted one at a time and solve the problem?
'(I'm going to try that later today or tomorrow) Or is it something else?
With ws1.Range("T1:U" & LR2)
'Then clear ws1.Range("T1:U LR2")
'
.Clear
End With
'resize the page to original row height
.Range("A1:A" & .Rows.Count).RowHeight = 11.25
End With
'send data to results worksheet
Worksheets(ws2Name).Select
Set ws2 = Worksheets(ws2Name)
With ws2
'Find last row used in column B = 2
LR3 = .Cells(Rows.Count, 2).End(xlUp).Row
'clear destination locations
With .Range("B3:C" & LR3)
.ClearContents
End With
End With
'copy data
With ws1.Range("A5:B" & LR)
.Copy ws2.Range("B3")
End With
'Turn on screen updating, and exit/finish the macro
Application.ScreenUpdating = True
End Sub