I'm developing a vba that projects the cost of a service. It calculates the quantitie of quotas and it's respective value (Colunms N and O). After the vba runs, the quantitie can be edited by the user and the value is recalculated. Now I have to input a SUM formula in a cell (Colunm M) that will sum the total of quantities of the quotas in the same row, however it is done in a for loop and for each supplier the number of quotas is variable (Number of quotas = qtdMeses), as seen in the code below. I'm having trouble to construct the SUM formula for each row. How can I put it in the code?
Sub ProcessarProjecaoEst()
Dim fLine, qtdMeses, LastLine, lineTitle, LastCol, LastColTitle, valor_col, valor_parc, novalinhaleilao, fim, ult_col
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ThisWorkbook
Set ws = wb.Sheets("Leilao")
Set wparam = wb.Sheets("Parametros")
ws.Activate
qtdMeses = ws.Range("B4")
lineTitle = 11
PrimeiraColunaQtde = 14
' Ativa a aba PARAMETROS
wparam.Activate
qtdeLinhasParam = wparam.Cells(Rows.Count, 1).End(xlUp).Row
' Ativa a aba LEILAO
ws.Activate
qtdeLinhasLeilao = ws.Cells(Rows.Count, 2).End(xlUp).Row
''PERCORRER PELOS PARAMETROS DOS LOTES
For lineParam = 6 To qtdeLinhasParam
qtdMeses = wparam.Range("C" & lineParam)
For lineLeilao = 12 To qtdeLinhasLeilao
If (ws.Range("A" & lineLeilao).Value = "0") And ws.Range("B" & lineLeilao).Value = "Lote " + wparam.Range("A" & lineParam) Then
'Gerar Cabecalhos
For i = 1 To qtdMeses
'Se for primeira PARCELA
If (i = 1) Then
LastColTitle = ws.Cells(lineLeilao, 16384).End(xlToLeft).Column
LastColTitle = PrimeiraColunaQtde
valueMes = wparam.Range("B" & lineParam).Value
ws.Range(Cells(lineLeilao - 3, LastColTitle), Cells(lineLeilao - 3, LastColTitle)).NumberFormat = "mmm-yy"
ws.Range(Cells(lineLeilao - 3, LastColTitle), Cells(lineLeilao - 3, LastColTitle)) = valueMes
ws.Range(Cells(lineLeilao - 3, LastColTitle), Cells(lineLeilao - 3, LastColTitle)).HorizontalAlignment = xlVAlignCenter
ws.Range(Cells(lineLeilao - 3, LastColTitle), Cells(lineLeilao - 3, LastColTitle)).Interior.Color = RGB(255, 242, 204)
ws.Range(Cells(lineLeilao - 3, LastColTitle), Cells(lineLeilao - 3, LastColTitle)).Font.Color = Black
ws.Range(Cells(lineLeilao - 3, LastColTitle), Cells(lineLeilao - 3, LastColTitle)).WrapText = True
ws.Range(Cells(lineLeilao - 3, LastColTitle), Cells(lineLeilao - 3, LastColTitle)).Font.Size = 9
ws.Range(Cells(lineLeilao - 3, LastColTitle), Cells(lineLeilao - 3, LastColTitle)).Font.Bold = True
ws.Range(Cells(lineLeilao - 2, LastColTitle), Cells(lineLeilao - 2, LastColTitle)) = "Parcela" & i
ws.Range(Cells(lineLeilao - 2, LastColTitle), Cells(lineLeilao - 2, LastColTitle)).HorizontalAlignment = xlVAlignCenter
ws.Range(Cells(lineLeilao - 2, LastColTitle), Cells(lineLeilao - 2, LastColTitle)).Interior.Color = RGB(21, 48, 65)
ws.Range(Cells(lineLeilao - 2, LastColTitle), Cells(lineLeilao - 2, LastColTitle)).Font.Color = RGB(255, 255, 255)
ws.Range(Cells(lineLeilao - 2, LastColTitle), Cells(lineLeilao - 2, LastColTitle)).WrapText = True
ws.Range(Cells(lineLeilao - 2, LastColTitle), Cells(lineLeilao - 2, LastColTitle)).Font.Size = 9
ws.Range(Cells(lineLeilao - 2, LastColTitle), Cells(lineLeilao - 2, LastColTitle)).Font.Bold = True
LastColTitle = ws.Cells(lineLeilao - 2, 16384).End(xlToLeft).Column
ws.Range(Cells(lineLeilao - 2, LastColTitle + 1), Cells(lineLeilao - 2, LastColTitle + 1)) = "Parcela" & i
ws.Range(Cells(lineLeilao - 2, LastColTitle + 1), Cells(lineLeilao - 2, LastColTitle + 1)).HorizontalAlignment = xlVAlignCenter
ws.Range(Cells(lineLeilao - 2, LastColTitle + 1), Cells(lineLeilao - 2, LastColTitle + 1)).Interior.Color = RGB(21, 48, 65)
ws.Range(Cells(lineLeilao - 2, LastColTitle + 1), Cells(lineLeilao - 2, LastColTitle + 1)).Font.Color = RGB(255, 255, 255)
ws.Range(Cells(lineLeilao - 2, LastColTitle + 1), Cells(lineLeilao - 2, LastColTitle + 1)).WrapText = True
ws.Range(Cells(lineLeilao - 2, LastColTitle + 1), Cells(lineLeilao - 2, LastColTitle + 1)).Font.Size = 9
ws.Range(Cells(lineLeilao - 2, LastColTitle + 1), Cells(lineLeilao - 2, LastColTitle + 1)).Font.Bold = True
'11
LastCol = ws.Cells(lineLeilao - 1, 16384).End(xlToLeft).Column
LastCol = PrimeiraColunaQtde
ws.Range(Cells(lineLeilao - 1, LastCol), Cells(lineLeilao - 1, LastCol)) = "Qtde"
ws.Range(Cells(lineLeilao - 1, LastCol), Cells(lineLeilao - 1, LastCol)).HorizontalAlignment = xlVAlignCenter
ws.Range(Cells(lineLeilao - 1, LastCol), Cells(lineLeilao - 1, LastCol)).VerticalAlignment = xlVAlignCenter
ws.Range(Cells(lineLeilao - 1, LastCol), Cells(lineLeilao - 1, LastCol)).WrapText = True
ws.Range(Cells(lineLeilao - 1, LastCol), Cells(lineLeilao - 1, LastCol)).Font.Size = 9
ws.Range(Cells(lineLeilao - 1, LastCol), Cells(lineLeilao - 1, LastCol)).Font.Bold = True
LastCol = ws.Cells(lineLeilao - 1, 16384).End(xlToLeft).Column
ws.Range(Cells(lineLeilao - 1, LastCol + 1), Cells(lineLeilao - 1, LastCol + 1)) = "Valor"
ws.Range(Cells(lineLeilao - 1, LastCol + 1), Cells(lineLeilao - 1, LastCol + 1)).HorizontalAlignment = xlVAlignCenter
ws.Range(Cells(lineLeilao - 1, LastCol + 1), Cells(lineLeilao - 1, LastCol + 1)).VerticalAlignment = xlVAlignCenter
ws.Range(Cells(lineLeilao - 1, LastCol + 1), Cells(lineLeilao - 1, LastCol + 1)).WrapText = True
ws.Range(Cells(lineLeilao - 1, LastCol + 1), Cells(lineLeilao - 1, LastCol + 1)).Font.Size = 9
ws.Range(Cells(lineLeilao - 1, LastCol + 1), Cells(lineLeilao - 1, LastCol + 1)).Font.Bold = True
Else
LastColTitle = ws.Cells(lineLeilao - 2, 16384).End(xlToLeft).Column
valueMes = wparam.Range("B" & lineParam).Value
ws.Range(Cells(lineLeilao - 3, LastColTitle + 1), Cells(lineLeilao - 3, LastColTitle + 1)).NumberFormat = "mmm-yy"
ws.Range(Cells(lineLeilao - 3, LastColTitle + 1), Cells(lineLeilao - 3, LastColTitle + 1)).FormulaR1C1 = "=SUM(RC[-2]+31)"
ws.Range(Cells(lineLeilao - 3, LastColTitle + 1), Cells(lineLeilao - 3, LastColTitle + 1)).HorizontalAlignment = xlVAlignCenter
ws.Range(Cells(lineLeilao - 3, LastColTitle + 1), Cells(lineLeilao - 3, LastColTitle + 1)).Interior.Color = RGB(255, 242, 204)
ws.Range(Cells(lineLeilao - 3, LastColTitle + 1), Cells(lineLeilao - 3, LastColTitle + 1)).Font.Color = Black
ws.Range(Cells(lineLeilao - 3, LastColTitle + 1), Cells(lineLeilao - 3, LastColTitle + 1)).WrapText = True
ws.Range(Cells(lineLeilao - 3, LastColTitle + 1), Cells(lineLeilao - 3, LastColTitle + 1)).Font.Size = 9
ws.Range(Cells(lineLeilao - 3, LastColTitle + 1), Cells(lineLeilao - 3, LastColTitle + 1)).Font.Bold = True
ws.Range(Cells(lineLeilao - 2, LastColTitle + 1), Cells(lineLeilao - 2, LastColTitle + 1)) = "Parcela" & i
ws.Range(Cells(lineLeilao - 2, LastColTitle + 1), Cells(lineLeilao - 2, LastColTitle + 1)).HorizontalAlignment = xlVAlignCenter
ws.Range(Cells(lineLeilao - 2, LastColTitle + 1), Cells(lineLeilao - 2, LastColTitle + 1)).Interior.Color = RGB(21, 48, 65)
ws.Range(Cells(lineLeilao - 2, LastColTitle + 1), Cells(lineLeilao - 2, LastColTitle + 1)).Font.Color = RGB(255, 255, 255)
ws.Range(Cells(lineLeilao - 2, LastColTitle + 1), Cells(lineLeilao - 2, LastColTitle + 1)).WrapText = True
ws.Range(Cells(lineLeilao - 2, LastColTitle + 1), Cells(lineLeilao - 2, LastColTitle + 1)).Font.Size = 9
ws.Range(Cells(lineLeilao - 2, LastColTitle + 1), Cells(lineLeilao - 2, LastColTitle + 1)).Font.Bold = True
LastColTitle = ws.Cells(lineLeilao - 2, 16384).End(xlToLeft).Column
ws.Range(Cells(lineLeilao - 2, LastColTitle + 1), Cells(lineLeilao - 2, LastColTitle + 1)) = "Parcela" & i
ws.Range(Cells(lineLeilao - 2, LastColTitle + 1), Cells(lineLeilao - 2, LastColTitle + 1)).HorizontalAlignment = xlVAlignCenter
ws.Range(Cells(lineLeilao - 2, LastColTitle + 1), Cells(lineLeilao - 2, LastColTitle + 1)).Interior.Color = RGB(21, 48, 65)
ws.Range(Cells(lineLeilao - 2, LastColTitle + 1), Cells(lineLeilao - 2, LastColTitle + 1)).Font.Color = RGB(255, 255, 255)
ws.Range(Cells(lineLeilao - 2, LastColTitle + 1), Cells(lineLeilao - 2, LastColTitle + 1)).WrapText = True
ws.Range(Cells(lineLeilao - 2, LastColTitle + 1), Cells(lineLeilao - 2, LastColTitle + 1)).Font.Size = 9
ws.Range(Cells(lineLeilao - 2, LastColTitle + 1), Cells(lineLeilao - 2, LastColTitle + 1)).Font.Bold = True
'11
LastCol = ws.Cells(lineLeilao - 1, 16384).End(xlToLeft).Column
ws.Range(Cells(lineLeilao - 1, LastCol + 1), Cells(lineLeilao - 1, LastCol + 1)) = "Qtde"
ws.Range(Cells(lineLeilao - 1, LastCol + 1), Cells(lineLeilao - 1, LastCol + 1)).HorizontalAlignment = xlVAlignCenter
ws.Range(Cells(lineLeilao - 1, LastCol + 1), Cells(lineLeilao - 1, LastCol + 1)).VerticalAlignment = xlVAlignCenter
ws.Range(Cells(lineLeilao - 1, LastCol + 1), Cells(lineLeilao - 1, LastCol + 1)).WrapText = True
ws.Range(Cells(lineLeilao - 1, LastCol + 1), Cells(lineLeilao - 1, LastCol + 1)).Font.Size = 9
ws.Range(Cells(lineLeilao - 1, LastCol + 1), Cells(lineLeilao - 1, LastCol + 1)).Font.Bold = True
ws.Range(Cells(lineLeilao - 1, LastCol + 1), Cells(lineLeilao - 1, LastCol + 1)).Font.Color = Black
LastCol = ws.Cells(lineLeilao - 1, 16384).End(xlToLeft).Column
ws.Range(Cells(lineLeilao - 1, LastCol + 1), Cells(lineLeilao - 1, LastCol + 1)) = "Valor"
ws.Range(Cells(lineLeilao - 1, LastCol + 1), Cells(lineLeilao - 1, LastCol + 1)).HorizontalAlignment = xlVAlignCenter
ws.Range(Cells(lineLeilao - 1, LastCol + 1), Cells(lineLeilao - 1, LastCol + 1)).VerticalAlignment = xlVAlignCenter
ws.Range(Cells(lineLeilao - 1, LastCol + 1), Cells(lineLeilao - 1, LastCol + 1)).WrapText = True
ws.Range(Cells(lineLeilao - 1, LastCol + 1), Cells(lineLeilao - 1, LastCol + 1)).Font.Size = 9
ws.Range(Cells(lineLeilao - 1, LastCol + 1), Cells(lineLeilao - 1, LastCol + 1)).Font.Bold = True
ws.Range(Cells(lineLeilao - 1, LastCol + 1), Cells(lineLeilao - 1, LastCol + 1)).Font.Color = Black
End If
Next
If ws.Range("A" & lineLeilao) = 0 Then
novalinhaleilao = lineLeilao + 1
End If
'LastCol = ws.Cells(11, 16384).End(xlToLeft).Column
If lineParam = 6 Then
LastCol = ws.Cells(11, 16384).End(xlToLeft).Column
Else
LastCol = ws.Cells(ult_col, 16384).End(xlToLeft).Column
lineTitle = novalinhaleilao - 2
End If
'Inserindo Fórmulas
LastLine = ws.Cells(Rows.Count, 1).End(xlUp).Row
For Row = 11 To LastLine
If fim <> 0 And ws.Range("A" & lineLeilao) = 0 Then
Row = novalinhaleilao
fim = 0
End If
For col = PrimeiraColunaQtde To LastCol
If ws.Range("A" & Row).Value = "F1" Then
If ws.Range(Cells(lineTitle, col), Cells(lineTitle, col)).Value = "Qtde" Then
' Qtde Dividida
ws.Range(Cells(Row, col), Cells(Row, col)).NumberFormat = "0"
ws.Range(Cells(Row, col), Cells(Row, col)) = ws.Range(Cells(Row, 4), Cells(Row, 4)).Value / qtdMeses
Else
' Valor dividido
ws.Range(Cells(Row, col), Cells(Row, col)).NumberFormat = _
"_-[$R$-pt-BR] * #,##0.00_-;-[$R$-pt-BR] * #,##0.00_-;_-[$R$-pt-BR] * ""-""??_-;_-#_-"
ws.Range(Cells(Row, col), Cells(Row, col)).FormulaR1C1 = "= RC[-1]/" & qtdMeses
ws.Range(Cells(Row, col), Cells(Row, col)).ColumnWidth = 15
End If
End If
If IsEmpty(ws.Range("A" & Row)) = True Then
GoTo prox
End If
Next
Next
End If
Next
prox: fim = 1
novalinhaleilao = Row + 1
ult_col = novalinhaleilao
Next
End Sub
Create a function to build a formula string.
Sub demo()
Dim qtdMeses: qtdMeses = 5
Cells(1, 1).FormulaR1C1 = QuotaSum(qtdMeses)
End Sub
Function QuotaSum(n) As String
Dim f As String, i As Long
For i = 1 To n * 2 Step 2
f = f & "+RC[" & i & "]"
Next
QuotaSum = "=" & f
End Function
Related
I am getting a 'run-time error 1004' when ever trying to run the below code. I've tried breaking it out but just can't see what is triggering. Any ideas would be greatly appreciated!
ThisWorkbook.Sheets("Processing").Cells(i, 14) = (WorksheetFunction.NetworkDays_Intl(ThisWorkbook.Sheets("Processing").Cells(i - 1, 2), ThisWorkbook.Sheets("Processing").Cells(i, 2), 1, (ThisWorkbook.Sheets("Validation").Range(Cells(3, 3), Cells(31, 3)) - 1)) _
* (ThisWorkbook.Sheets("Validation").Cells(3, 2) - ThisWorkbook.Sheets("Validation").Cells(3, 1)) _
+ Calc _
- WorksheetFunction.Median( _
WorksheetFunction.NetworkDays_Intl(ThisWorkbook.Sheets("Processing").Cells(i - 1, 2), ThisWorkbook.Sheets("Processing").Cells(i - 1, 2), 1, ThisWorkbook.Sheets("Validation").Range(Cells(3, 3), Cells(31, 3))) * ThisWorkbook.Sheets("Processing").Cells(i - 1, 2) Mod 1, _
ThisWorkbook.Sheets("Validation").Cells(3, 1), _
ThisWorkbook.Sheets("Validation").Cells(3, 2)))
Full Code:
Sub PendingCustomer()
Dim i, LastRow As Integer
Dim Calc As Integer
LastRow = ThisWorkbook.Sheets("Processing").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To LastRow
If (ThisWorkbook.Sheets("Processing").Cells(i, 10) = "3") Or (ThisWorkbook.Sheets("Processing").Cells(i, 10) = "4") Then
If (ThisWorkbook.Sheets("Processing").Cells(i, 5) = "Pending - Customer") And (UCase(ThisWorkbook.Sheets("Processing").Cells(i, 9)) Like "VZB*") And (ThisWorkbook.Sheets("Processing").Cells(i, 8) > ThisWorkbook.Sheets("Processing").Cells(i - 1, 8)) Then
If WorksheetFunction.NetworkDays_Intl(ThisWorkbook.Sheets("Processing").Cells(i, 2), ThisWorkbook.Sheets("Processing").Cells(i, 2), 1, ThisWorkbook.Sheets("Validation").Range("C3:C31")) > 0 Then
Calc = WorksheetFunction.Median(ThisWorkbook.Sheets("Processing").Cells(i, 2) Mod 1, ThisWorkbook.Sheets("Validation").Cells(2, 2), ThisWorkbook.Sheets("Validation").Cells(3, 2))
Else: Calc = ThisWorkbook.Sheets("Validation").Cells(3, 2)
End If
ThisWorkbook.Sheets("Processing").Cells(i, 14) = (WorksheetFunction.NetworkDays_Intl(ThisWorkbook.Sheets("Processing").Cells(i - 1, 2), ThisWorkbook.Sheets("Processing").Cells(i, 2), 1, (ThisWorkbook.Sheets("Validation").Range(Cells(3, 3), Cells(31, 3)) - 1)) _
* (ThisWorkbook.Sheets("Validation").Cells(3, 2) - ThisWorkbook.Sheets("Validation").Cells(3, 1)) _
+ Calc _
- WorksheetFunction.Median( _
WorksheetFunction.NetworkDays_Intl(ThisWorkbook.Sheets("Processing").Cells(i - 1, 2), ThisWorkbook.Sheets("Processing").Cells(i - 1, 2), 1, ThisWorkbook.Sheets("Validation").Range(Cells(3, 3), Cells(31, 3))) * ThisWorkbook.Sheets("Processing").Cells(i - 1, 2) Mod 1, _
ThisWorkbook.Sheets("Validation").Cells(3, 1), _
ThisWorkbook.Sheets("Validation").Cells(3, 2)))
End If
ElseIf (ThisWorkbook.Sheets("Processing").Cells(i, 5) = "Pending - Customer") And (UCase(ThisWorkbook.Sheets("Processing").Cells(i, 9)) Like "VZB*") And (ThisWorkbook.Sheets("Processing").Cells(i, 8) > ThisWorkbook.Sheets("Processing").Cells(i - 1, 8)) Then
ThisWorkbook.Sheets("Processing").Cells(i, 14) = ThisWorkbook.Sheets("Processing").Cells(i, 2) - ThisWorkbook.Sheets("Processing").Cells(i - 1, 2)
Else: ThisWorkbook.Sheets("Processing").Cells(i, 14) = ""
End If
Next
ThisWorkbook.Sheets("Processing").Columns(14).NumberFormat = "[mm]:ss"
End Sub
Data Set:
Validation Tab
Processing Tab
Issue found.
In the NetworkDays_Intl function:
.Range(Cells(3, 3), Cells(31, 3))
does not work, had to use
.Range("C3:C31")
Update 7/24
Here is the code currently.
'insert blank row based on if Total Sum is on Column K
Dim FirstRow As Long, LastRow As Long, Col As Long
FinalRow = Cells(Worksheets("page1").Rows.Count, 1).End(xlUp).Row
For j = 12 To 14
For i = FinalRow + 8 To 1 Step -1
Do While IsEmpty(Cells(i, j))
If IsEmpty(Cells(i - 1, j)) Then
FirstRow = i - 1
LastRow = FirstRow
Else
LastRow = i - 1
FirstRow = Cells(i - 1, j).End(xlUp).Row
End If
Cells(LastRow + 1, j) = Application.WorksheetFunction.Sum(Range(Cells(FirstRow, j), Cells(LastRow, j)))
If Cells(LastRow + 1, 12) >= 1 Then
Cells(LastRow + 1, 11).FormulaLocal = "Total Sum"
If Cells(LastRow + 1, 11) = "Total Sum" Then
Cells(LastRow + 1, j) = "=Sum(" & Range(Cells(FirstRow, j), Cells(LastRow, j)).Address(False, False) & ")"
End If
Cells(LastRow + 3, 11).FormulaLocal = "China"
If Cells(LastRow + 3, 11) = "China" Then
Cells(LastRow + 3, j).FormulaLocal = _
"=Sum(SUMIF(" & Addr(FirstRow, LastRow, 8) & "), ""XINGANG""," & Addr(FirstRow, LastRow, 12) & "))"
'Cells(LastRow + 3, j).FormulaLocal = "=Sum(" & Range(Cells(FirstRow, j), Cells(LastRow, j)).Address(False, False) & ")"
'Cells(lastRow + 3, j).FormulaLocal = "=Sum(Sumif((" & Range(Cells(firstRow, 8), Cells(lastRow, 8)).Address(False, False) & "), ""Xingang"",(" & Range(Cells(firstRow, 12), Cells(lastRow, 12)).Address(False, False) & "))"
If Cells(LastRow + 2, 11) = "" Then
Worksheets("Page1").Cells(LastRow + 2, j).ClearContents
End If
End If
Cells(LastRow + 4, 11).FormulaLocal = "Abu Dhabi"
If Cells(LastRow + 4, 11) = "Abu Dhabi" Then
Cells(LastRow + 4, j).FormulaLocal = "=Sum(" & Range(Cells(FirstRow, j), Cells(LastRow, j)).Address(False, False) & ")"
End If
Cells(LastRow + 5, 11).FormulaLocal = "Other"
If Cells(LastRow + 5, 11) = "Other" Then
Cells(LastRow + 5, j).FormulaLocal = "=Sum(" & Range(Cells(FirstRow, j), Cells(LastRow, j)).Address(False, False) & ")"
End If
Cells(LastRow + 6, 11).FormulaLocal = "H1 & H2"
If Cells(LastRow + 6, 11) = "H1 & H2" Then
Cells(LastRow + 6, j).FormulaLocal = "=Sum(" & Range(Cells(FirstRow, j), Cells(LastRow, j)).Address(False, False) & ")"
End If
Cells(LastRow + 7, 11).FormulaLocal = "Product"
If Cells(LastRow + 7, 11) = "Product" Then
Cells(LastRow + 7, j).FormulaLocal = "=Sum(" & Range(Cells(FirstRow, j), Cells(LastRow, j)).Address(False, False) & ")"
If Cells(LastRow + 7, 12) >= 1 Then
For Z = 11 To 14 '
Cells(LastRow + 12, 11).EntireRow.ClearContents
Cells(LastRow + 13, 11).EntireRow.ClearContents
Cells(LastRow + 14, 11).EntireRow.ClearContents
Cells(LastRow + 8, 11).FormulaLocal = "Delete"
Cells(LastRow + 9, 11).FormulaLocal = "Delete"
Cells(LastRow + 10, 11).FormulaLocal = "Delete"
Cells(LastRow + 11, 11).FormulaLocal = "Delete"
Next Z
End If
End If
End If
Loop
Next i
Next j
'Finding 'Delete' and delete entire row
Dim rFound As Range, Str As String
On Error Resume Next
Str = "Delete"
Do
Set rFound = Cells.Find(Str, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows)
If Not rFound Is Nothing Then Rows(rFound.Row).EntireRow.Delete xlShiftUp
Loop Until rFound Is Nothing
Application.ScreenUpdating = True
End Sub
Function Addr(FirstRow As Long, LastRow As Long, Col As Long) As String
Addr = Range(Cells(FirstRow, Col), Cells(LastRow, Col)).Address(False, False)
End Function
Running this gives me Run Time Error '1004' and it highlights this formula.
Cells(LastRow + 3, j).FormulaLocal = _
"=Sum(SUMIF(" & Addr(FirstRow, LastRow, 8) & "), ""XINGANG""," & Addr(FirstRow, LastRow, 12) & "))"
If it helps,
this is what the sheet looks like after running this
I need help with entering SUMIF formulas that have variable/dynamic rows.
I am new to VBA, so the references I've used for my code are these:
1) sum between blank rows,
2) previous question I've asked
The data that I have is separated by blank rows for every different week, which changes constantly. I'm trying to have SUMIF formulas in between each group of data, but I'm stuck on how to change it.
Reference to what my excel looks like
The first row and last row will change depending on the week. In the code, they should be defined as firstrow and lastrow, respectfully. Here are the SUMIF formulas I'm trying to put in its place.
=SUMIF(P138:P158,"<>* Hold *",L138:L158)
=SUM(SUMIF(H5:H21,{"Chongqing","Dalian","Fuzhou","Huangpu","Lianyungang","Nanjing","Nansha","Nantong","NingBo","Qingdao","Shekou","Xiamen","Yantian","Xingang","Shanghai","Mawei"},L5:L21))
=SUM(SUMIF(H5:H21,{"Abu Dhabi","Jebel","Khalifa"},L5:L21))
=SUM(SUMIF(O12:O28,{"*H1*"},L12:L28))
=SUM(SUMIF(O12:O28,{"H2","H2-PRESSED"},L12:L28))
Here is the formula I've been using as a placeholder.
Cells(LastRow + 7, j).FormulaLocal = "=Sum(" & Range(Cells(FirstRow, j), Cells(LastRow, j)).Address(False, False) & ")"
I've tried to simply edit the formula, but when I use the below, it gives me a syntax error. And when I put "Xingang" into a cell and use that cell as the value instead, it gives me a 1004 Error.
Cells(LastRow + 3, j).FormulaLocal = "=Sum(SUMIF((" & Range(Cells(FirstRow, j), Cells(LastRow, j)).Address(False, False) & "), "XINGANG",(" & Range(Cells(FirstRow, j), Cells(LastRow, j)).Address(False, False) & "))"
Here is the full code in case.
finalrow = Cells(Worksheets("page1").Rows.Count, 1).End(xlUp).Row
For j = 12 To 14
For i = finalrow + 8 To 1 Step -1
Do While IsEmpty(Cells(i, j))
If IsEmpty(Cells(i - 1, j)) Then
FirstRow = i - 1
LastRow = FirstRow
Else
LastRow = i - 1
FirstRow = Cells(i - 1, j).End(xlUp).Row
End If
Cells(LastRow + 1, j) = Application.WorksheetFunction.Sum(Range(Cells(FirstRow, j), Cells(LastRow, j)))
If Cells(LastRow + 1, 12) >= 1 Then
Cells(LastRow + 1, 11).FormulaLocal = "Total Sum"
If Cells(LastRow + 1, 11) = "Total Sum" Then
Cells(LastRow + 1, j) = "=Sum(" & Range(Cells(FirstRow, j), Cells(LastRow, j)).Address(False, False) & ")"
End If
Cells(LastRow + 3, 11).FormulaLocal = "China"
If Cells(LastRow + 3, 11) = "China" Then
Cells(LastRow + 3, j).FormulaLocal = "=Sum(" & Range(Cells(FirstRow, j), Cells(LastRow, j)).Address(False, False) & ")"
If Cells(LastRow + 2, 11) = "" Then
Worksheets("Page1").Cells(LastRow + 2, j).ClearContents
End If
End If
Cells(LastRow + 4, 11).FormulaLocal = "Abu Dhabi"
If Cells(LastRow + 4, 11) = "Abu Dhabi" Then
Cells(LastRow + 4, j).FormulaLocal = "=Sum(" & Range(Cells(FirstRow, j), Cells(LastRow, j)).Address(False, False) & ")"
End If
Cells(LastRow + 5, 11).FormulaLocal = "Other"
If Cells(LastRow + 5, 11) = "Other" Then
Cells(LastRow + 5, j).FormulaLocal = "=Sum(" & Range(Cells(FirstRow, j), Cells(LastRow, j)).Address(False, False) & ")"
End If
Cells(LastRow + 6, 11).FormulaLocal = "H1 & H2"
If Cells(LastRow + 6, 11) = "H1 & H2" Then
Cells(LastRow + 6, j).FormulaLocal = "=Sum(" & Range(Cells(FirstRow, j), Cells(LastRow, j)).Address(False, False) & ")"
End If
Cells(LastRow + 7, 11).FormulaLocal = "Product"
If Cells(LastRow + 7, 11) = "Product" Then
Cells(LastRow + 7, j).FormulaLocal = "=Sum(" & Range(Cells(FirstRow, j), Cells(LastRow, j)).Address(False, False) & ")"
If Cells(LastRow + 7, 12) >= 1 Then
For Z = 11 To 14 '
Cells(LastRow + 12, 11).EntireRow.ClearContents
Cells(LastRow + 13, 11).EntireRow.ClearContents
Cells(LastRow + 14, 11).EntireRow.ClearContents
Cells(LastRow + 8, 11).FormulaLocal = "Delete"
Cells(LastRow + 9, 11).FormulaLocal = "Delete"
Cells(LastRow + 10, 11).FormulaLocal = "Delete"
Cells(LastRow + 11, 11).FormulaLocal = "Delete"
Next Z
End If
End If
End If
Loop
Next i
Next j
Something more like this:
Edit - removed extra ")" in formula
Cells(LastRow + 3, j).FormulaArray = _
"=Sum(SUMIF(" & Addr(FirstRow, LastRow, 8) & _
", ""XINGANG""," & Addr(FirstRow, LastRow, j) & "))"
I used this helper function to reduce the volume of your code by abstracting out the range address generation:
'helper function
Function Addr(firstRow as Long, lastRow as long, col as long) As String
Addr = Range(Cells(firstRow, col), Cells(lastRow, col)).Address(False, False)
End Function
Add this function in the module where your main code is.
# Tim, thank you for your help!
In case anyone has a similar question, here is what the formula looks like now.
Cells(LastRow + 3, j).FormulaArray = _
"=Sum(SUMIF(" & Addr(FirstRow, LastRow, 8) & ", {""XINGANG"",""Dalian"",""NANSHA""}," & Addr(FirstRow, LastRow, 12) & "))"
How can I make this code shorter?
r = 11
Do While Not tgtWSheet.Cells(r, 2) = "0"
If tgtWSheet.Cells(r, 2) = tgtWSheet.Cells(r + 1, 2) Or tgtWSheet.Cells(r, 2) = tgtWSheet.Cells(r + 2, 2) Or _
tgtWSheet.Cells(r, 2) = tgtWSheet.Cells(r + 3, 2) Or tgtWSheet.Cells(r, 2) = tgtWSheet.Cells(r + 4, 2) Or _
tgtWSheet.Cells(r, 2) = tgtWSheet.Cells(r + 5, 2) Or tgtWSheet.Cells(r, 2) = tgtWSheet.Cells(r + 6, 2) Or _
tgtWSheet.Cells(r, 2) = tgtWSheet.Cells(r + 7, 2) Or tgtWSheet.Cells(r, 2) = tgtWSheet.Cells(r + 8, 2) Or _
tgtWSheet.Cells(r, 2) = tgtWSheet.Cells(r + 9, 2) Or tgtWSheet.Cells(r, 2) = tgtWSheet.Cells(r + 10, 2) Or _
tgtWSheet.Cells(r, 2) = tgtWSheet.Cells(r + 11, 2) Or tgtWSheet.Cells(r, 2) = tgtWSheet.Cells(r + 12, 2) Or _
tgtWSheet.Cells(r, 2) = tgtWSheet.Cells(r + 13, 2) Or tgtWSheet.Cells(r, 2) = tgtWSheet.Cells(r + 14, 2) Or _
tgtWSheet.Cells(r, 2) = tgtWSheet.Cells(r + 15, 2) Or tgtWSheet.Cells(r, 2) = tgtWSheet.Cells(r + 16, 2) Or _
tgtWSheet.Cells(r, 2) = tgtWSheet.Cells(r + 17, 2) Or tgtWSheet.Cells(r, 2) = tgtWSheet.Cells(r + 18, 2) Then
MsgBox "Duplicate Record Found!"
Exit Sub
Else
r = r + 1
End If
Loop
Using the WorksheetFunction.CountIF you can count the number of times a particular values in your case Range(r & "2) is repeated in a range and using that result we can compute if the value is duplicated.
r = 11
Do While Not tgtWSheet.Cells(r, 2) = "0"
IF WorksheetFunction.CountIF(tgtWSheet.Range("B" & r & ":S" & r),tgtWSheet.Range("B" & r)) > 1 Then
MsgBox "Duplicate Record Found!"
Exit Sub
Else
r = r + 1
End If
Loop
you could use .Find() method of "Range" object
Option Explicit
Sub main()
Dim rowOffset As Long
Dim tgtWSheet As Worksheet
Set tgtWSheet = ThisWorkbook.Worksheets("tgtW") '<== adapt to your needs
With tgtWSheet.Cells(11, 2)
Do While .Offset(rowOffset).Value <> "0"
If .Offset(rowOffset + 1).Resize(18).Find(What:=.Offset(rowOffset), LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False) Is Nothing Then
rowOffset = rowOffset + 1
Else
MsgBox "Duplicate Record Found!"
Exit Sub
End If
Loop
End With
End Sub
With the use of a For cycle:
r = 11
Do Until tgtWSheet.Cells(r, 2) = "0"
for i = 1 to 18
If tgtWSheet.Cells(r, 2) = tgtWSheet.Cells(r + i, 2) Then
MsgBox "Duplicate Record Found!"
Exit Sub
Else
r = r + 1
End If
next
Loop
Be careful though! The code stops at the first "0" encountered.
BONUS: Do While Not = Do Until
Above is what the code below does.
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim i As Long
Dim k As Long
Set ws = ActiveSheet
With ws
For i = 1 To 200
If Left(.Cells(i, 1).Value, 2) = "HW" Then
On Error Resume Next
k = .Range(.Cells(i + 1, 1), .Cells(200, 1)).Find("HW").Row
On Error GoTo 0
If k <= i Then k = 200
.Cells(i, 10).Value = Len(Cells((i + 2), 1).Value) - Len(Replace(Cells((i + 2), 1).Value, ",", "")) + 1
.Cells(i, 11).Value = "SET"
.Cells(i, 12).Resize(k - i).Value = .Cells(i, 1).Resize(k - i).Value
.Cells((i + 1), 12).Resize(k - i).Value = .Cells((i + 1), 1).Resize(k - i).Value
.Cells((i + 2), 12).Resize(k - i).Value = ws.Cells((i + 2), 1).Resize(k - i).Value
.Cells((i + 3), 12).Resize(k - i).Value = ""
.Cells((i + 4), 12).Resize(k - i).Value = "QTY"
.Cells((i + 4), 13).Resize(k - i).Value = "TYPE"
.Cells((i + 4), 15).Resize(k - i).Value = "LENGTH"
.Cells((i + 4), 16).Resize(k - i).Value = "FINISH"
.Cells((i + 4), 19).Resize(k - i).Value = "LIST"
.Cells((i + 4), 20).Resize(k - i).Value = "NET"
.Cells((i + 4), 21).Resize(k - i).Value = "MFG"
.Cells((i + 4), 22).Resize(k - i).Value = "MODEL"
.Cells((i + 5), 12).Resize(k - i).Value = .Cells((i + 3), 1).Resize(k - i).Value
.Cells((i + 5), 13).Resize(k - i).Value = .Cells((i + 3), 2).Resize(k - i).Value
.Cells((i + 5), 15).Resize(k - i).Value = .Cells((i + 3), 5).Resize(k - i).Value
.Cells((i + 5), 16).Resize(k - i).Value = .Cells((i + 3), 6).Resize(k - i).Value
.Cells((i + 5), 19).Resize(k - i).Value = .Cells((i + 3), 7).Resize(k - i).Value
.Cells((i + 5), 20).Resize(k - i).Value = .Cells((i + 3), 8).Resize(k - i).Value
.Cells((i + 5), 21).Resize(k - i).Value = .Cells((i + 3), 3).Resize(k - i).Value
.Cells((i + 5), 22).Resize(k - i).Value = .Cells((i + 3), 4).Resize(k - i).Value
i = k + 1
End If
Next i
End With
End Sub
A couple problems. First I'm not sure why but for the second data output it is missing the # of doors, SET, and all the different hardware. It looks like it is skipping it?
Second problem is i do not know how to make my headings (QTY, TYPE, LENGTH, FINISH, LIST, NET, MFG, MODEL) bold using VBA code. I think i would use text.bold but i don't think i know how to word it correctly.I would also like to put a double line underneath them including column N but excluding Q and R.
Third I would like to sum my NET prices at the end of the NET column, but im not sure how to specify that cell. I would also like the cell to the right of it to divide the sum of the net by a specific cell.
Forth, I tried doing this,
"DOOR: " & ws.Cells((i + 2), 1).Resize(k - i).Value
This triggers an error because one is a string and the other is an integer. I thought i could use CStr(), but that does not work.
When all is coded correctly i would like it to look like this.
Thanks in advance for any help!
I would move all the title row into an Array. Then you can just resize the area and assign the array.
As to your problems:
1) Math, when adding rows and refering to data that does not add the rows also there is a lot of math. You were basically overwriting data as you went.
2) one way to format the bold is Range.Font.Bold = True. With that the borders are similar Range.Borders(XlEdgeBottom).LineStyle = xlDouble.
3) Again Lots and Lots of math, Sometimes it is trial and error to get it correct.
4) You can't do that with a resize, it does not like it
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim i As Long
Dim k As Long
Set ws = ActiveSheet
Dim ofst As Long
Dim ttlArr() As String
ttarr = Array("QTY", "TYPE", vbNullString, "LENGTH", "FINISH", vbNullString, vbNullString, "LIST", "NET", "MFG", "MODEL")
ofst = 0
With ws
For i = 1 To 200
If Left(.Cells(i, 1).Value, 2) = "HW" Then
On Error Resume Next
k = .Range(.Cells(i + 1, 1), .Cells(200, 1)).Find("HW").Row
On Error GoTo 0
If k <= i Then k = .Cells(i, 1).End(xlDown).Row + 2
.Cells(i + ofst, 11).Value = "SET"
.Cells(i + ofst, 12).Resize(2).Value = .Cells(i, 1).Resize(2).Value
If IsNumeric(.Cells((i + 2), 1).Value) Then
.Cells(i + ofst, 10).Value = Len("'" & Format(.Cells(i + 2, 1).Value, "#,##0")) - Len(Replace("'" & Format(.Cells(i + 2, 1).Value, "#,##0"), ",", "")) + 1
.Cells(i + ofst + 2, 12).Value = "Doors: " & Format(.Cells(i + 2, 1).Value, "#,##0")
Else
.Cells(i + ofst, 10).Value = Len(.Cells(i + 2, 1).Value) - Len(Replace(.Cells(i + 2, 1).Value, ",", "")) + 1
.Cells(i + ofst + 2, 12).Value = "Doors: " & .Cells(i + 2, 1).Value
End If
.Cells(i + ofst + 4, 12).Resize(, UBound(ttarr) + 1).Value = ttarr
.Cells(i + ofst + 4, 12).Resize(, UBound(ttarr) + 1).Font.Bold = True
.Cells(i + ofst + 4, 12).Resize(, 5).Borders(xlEdgeBottom).LineStyle = xlDouble
.Cells(i + ofst + 4, 19).Resize(, 4).Borders(xlEdgeBottom).LineStyle = xlDouble
ofst = ofst + 2
.Cells(i + ofst + 3, 12).Resize(k - i - 3).Value = .Cells(i + 3, 1).Resize(k - i - 3).Value
.Cells(i + ofst + 3, 13).Resize(k - i - 3).Value = .Cells(i + 3, 2).Resize(k - i - 3).Value
.Cells(i + ofst + 3, 15).Resize(k - i - 3).Value = .Cells(i + 3, 5).Resize(k - i - 3).Value
.Cells(i + ofst + 3, 16).Resize(k - i - 3).Value = .Cells(i + 3, 6).Resize(k - i - 3).Value
.Cells(i + ofst + 3, 19).Resize(k - i - 3).Value = .Cells(i + 3, 7).Resize(k - i - 3).Value
.Cells(i + ofst + 3, 20).Resize(k - i - 3).Value = .Cells(i + 3, 8).Resize(k - i - 3).Value
.Cells(i + ofst + 3, 21).Resize(k - i - 3).Value = .Cells(i + 3, 3).Resize(k - i - 3).Value
.Cells(i + ofst + 3, 22).Resize(k - i - 3).Value = .Cells(i + 3, 4).Resize(k - i - 3).Value
.Cells(i + ofst + k - i - 1, 20).Value = WorksheetFunction.Sum(.Cells(i + ofst + 3, 20).Resize(k - i - 4))
' Change the Range("H1") to your cell with the factor
.Cells(i + ofst + k - i - 1, 21).Value = .Cells(i + ofst + k - i - 1, 20).Value / .Range("H1")
.Cells(i + ofst - 2, 17).Value = .Cells(i + ofst + k - i - 1, 21).Value
.Cells(i + ofst - 2, 18).Value = .Cells(i + ofst + k - i - 1, 21).Value * .Cells(i + ofst - 2, 10).Value
i = k - 1
End If
Next i
End With
End Sub
I believe the problem with lost data had to do with finding the last occurrence of HW* when there was no terminating HW* to locate the end-of-record. Without seeing one or two HW records as a sample, this is the best I could figure out.
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim i As Long, k As Long, hw As Long, MX As Long
Set ws = ActiveSheet
With ws
MX = 200 'maybe MX = .cells(rows.count, 1).end(xlup).row
i = .Columns(1).Find(what:="HW*", after:=.Cells(MX, 1), lookat:=xlWhole).Row
k = .Columns(1).FindNext(after:=.Cells(i, 1)).Row
For hw = 1 To Application.CountIf(.Columns(1), "HW*")
If k <= i Then k = MX
Debug.Print i & ":" & k
.Cells(i, 10) = UBound(Split(.Cells(i + 2, 1).Value, Chr(44))) + 1
.Cells(i, 11).Value = "SET"
.Cells(i, 12).Resize(k - i).Value = .Cells(i, 1).Resize(k - i).Value
With .Cells(i + 4, 12)
.Resize(1, 11) = Array("QTY", "TYPE", vbNullString, _
"LENGTH", "FINISH", vbNullString, vbNullString, _
"LIST", "NET", "MFG", "MODEL")
With Union(.Cells(1, 1).Resize(1, 5), .Cells(1, 1).Resize(1, 5))
.Font.Bold = True
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
End With
End With
End With
.Cells((i + 5), 12).Resize(k - i).Value = .Cells((i + 3), 1).Resize(k - i).Value
.Cells((i + 5), 13).Resize(k - i).Value = .Cells((i + 3), 2).Resize(k - i).Value
.Cells((i + 5), 15).Resize(k - i).Value = .Cells((i + 3), 5).Resize(k - i).Value
.Cells((i + 5), 16).Resize(k - i).Value = .Cells((i + 3), 6).Resize(k - i).Value
.Cells((i + 5), 19).Resize(k - i).Value = .Cells((i + 3), 7).Resize(k - i).Value
.Cells((i + 5), 20).Resize(k - i).Value = .Cells((i + 3), 8).Resize(k - i).Value
.Cells((i + 5), 21).Resize(k - i).Value = .Cells((i + 3), 3).Resize(k - i).Value
.Cells((i + 5), 22).Resize(k - i).Value = .Cells((i + 3), 4).Resize(k - i).Value
i = .Columns(1).FindNext(after:=.Cells(k - 1, 1)).Row
k = .Columns(1).FindNext(after:=.Cells(i, 1)).Row
Next hw
End With
End Sub
Dim ws As Worksheet
Dim MyWSTarget As Worksheet
Dim i As Long
Dim k As Long
Set ws = ActiveSheet
Set MyWSTarget = Workbooks.Open("C:\MASTER_QT.xlsx").Sheets(1)
Dim ofst As Long
Dim ttlArr() As String
ttarr = Array("QTY", "TYPE", vbNullString, "LENGTH", "FINISH", vbNullString, vbNullString, "LIST", "NET", "MFG", "MODEL")
ofst = 17
With ws
For i = 1 To 200
If Left(ws.Cells(i, 1).Value, 2) = "HW" Then
On Error Resume Next
k = ws.Range(ws.Cells(i + 1, 1), ws.Cells(200, 1)).Find("HW").Row
On Error GoTo 0
If k <= i Then k = ws.Cells(i, 1).End(xlDown).Row + 2
MyWSTarget.Cells(i + ofst, 3).Value = "SET"
MyWSTarget.Cells(i + ofst, 4).Resize(2).Value = ws.Cells(i, 1).Resize(2).Value
If IsNumeric(MyWSTarget.Cells((i + 2), 1).Value) Then
MyWSTarget.Cells(i + ofst, 2).Value = Len("'" & Format(ws.Cells(i + 2, 1).Value, "#,##0")) - Len(Replace("'" & Format(ws.Cells(i + 2, 1).Value, "#,##0"), ",", "")) + 1
MyWSTarget.Cells(i + ofst + 2, 4).Value = "Doors: " & Format(ws.Cells(i + 2, 1).Value, "#,##0")
Else
MyWSTarget.Cells(i + ofst + 2, 4).Value = "Doors: " & ws.Cells(i + 2, 1).Value
End If
MyWSTarget.Cells(i + ofst + 4, 3).Resize(, UBound(ttarr) + 1).Value = ttarr
MyWSTarget.Cells(i + ofst + 4, 3).Resize(, UBound(ttarr) + 1).Font.Bold = True
MyWSTarget.Cells(i + ofst + 4, 3).Resize(, 5).Borders(xlEdgeBottom).LineStyle = xlDouble
MyWSTarget.Cells(i + ofst + 4, 10).Resize(, 4).Borders(xlEdgeBottom).LineStyle = xlDouble
ofst = ofst + 2
MyWSTarget.Cells(i + ofst + 3, 3).Resize(k - i - 3).Value = ws.Cells(i + 3, 1).Resize(k - i - 3).Value
MyWSTarget.Cells(i + ofst + 3, 4).Resize(k - i - 3).Value = ws.Cells(i + 3, 2).Resize(k - i - 3).Value
MyWSTarget.Cells(i + ofst + 3, 6).Resize(k - i - 3).Value = ws.Cells(i + 3, 5).Resize(k - i - 3).Value
MyWSTarget.Cells(i + ofst + 3, 7).Resize(k - i - 3).Value = ws.Cells(i + 3, 6).Resize(k - i - 3).Value
MyWSTarget.Cells(i + ofst + 3, 10).Resize(k - i - 3).Value = ws.Cells(i + 3, 7).Resize(k - i - 3).Value
MyWSTarget.Cells(i + ofst + 3, 11).Resize(k - i - 3).Value = ws.Cells(i + 3, 8).Resize(k - i - 3).Value
MyWSTarget.Cells(i + ofst + 3, 12).Resize(k - i - 3).Value = ws.Cells(i + 3, 3).Resize(k - i - 3).Value
MyWSTarget.Cells(i + ofst + 3, 13).Resize(k - i - 3).Value = ws.Cells(i + 3, 4).Resize(k - i - 3).Value
MyWSTarget.Cells(i + ofst + k - i - 1, 11).Value = WorksheetFunction.Sum(MyWSTarget.Cells(i + ofst + 3, 11).Resize(k - i - 4))
' Change the Range("H1") to your cell with the factor
MyWSTarget.Cells(i + ofst + k - i - 1, 12).Value = MyWSTarget.Cells(i + ofst + k - i - 1, 11).Value / MyWSTarget.Range("L12")
MyWSTarget.Cells(i + ofst - 2, 8).Value = MyWSTarget.Cells(i + ofst + k - i - 1, 12).Value
MyWSTarget.Cells(i + ofst - 2, 9).Value = MyWSTarget.Cells(i + ofst + k - i - 1, 12).Value * MyWSTarget.Cells(i + ofst - 2, 2).Value
i = k - 1
End If
Next i
End With
End Sub
I have a macro which adds specific vales to specific strings. However I am currently getting a runtime error, which I can not figure out why?
Case "L"
If UCase(Left(Dn, 3)) = "L/M" Then
Dn.Offset(, 1) = Val(Mid(Dn, 4, 2)) + 35
ElseIf UCase(Left(Dn, 2)) = "LM" Then
'Dn.Offset(, 1) = Val(Mid(Dn, 3, 3)) + 3.5
If IsNumeric(Mid(Dn, 3, 1)) And IsNumeric(Mid(Dn, 4, 1)) Then
If Mid(Dn, 4, 1) = "0" Then
Dn.Offset(, 1) = Mid(Dn, 3, 2) + 3.5
Else
Dn.Offset(, 1) = Mid(Dn, 3, 2) + 0.35
End If
End If
If IsNumeric(Mid(Dn, 4, 1)) And IsNumeric(Mid(Dn, 5, 1)) Then
If Mid(Dn, 5, 1) = "0" Then
Dn.Offset(, 1) = Mid(Dn, 3, 3) + 35
Else
Dn.Offset(, 1) = Mid(Dn, 3, 3) + 0.35
End If
End If
ElseIf UCase(Left(Dn, 3)) = "LOW" Then
Dn.Offset(, 1) = Val(Mid(Dn, 4, 2)) + 20
ElseIf UCase(Left(Dn, 3)) = "LO-" Then
Dn.Offset(, 1) = Val(Mid(Dn, 4, 2)) + 20
ElseIf UCase(Left(Dn, 6)) = "LO MID" Then
Dn.Offset(, 1) = Val(Mid(Dn, 7, 3)) + 35
ElseIf UCase(Left(Dn, 2)) = "L+" Then
Dn.Offset(, 1) = Num
ElseIf UCase(Left(Dn, 3)) = "LO " Then
Dn.Offset(, 1) = Val(Mid(Dn, 4, 2)) + 20
'ElseIf UCase(Left(Dn, 1)) = "L" Then
'Dn.Offset(, 1) = Val(Mid(Dn, 2, 3)) + 2
'ElseIf IsNumeric(Mid(Dn, 2, 1)) Then
'Dn.Offset(, 1) = IIf(IsNumeric(Mid(Dn, 2, 1) + Mid(Dn, 3, 1)), Val(Mid(Dn, 2, 3)) + 2, Val(Mid(Dn, 2, 1)) + 0.2)
ElseIf IsNumeric(Mid(Dn, 2, 1)) And IsNumeric(Mid(Dn, 3, 1)) Then
If Mid(Dn, 3, 1) = "0" Then
Dn.Offset(, 1) = Mid(Dn, 2, 2) + 2
Else
Dn.Offset(, 1) = Mid(Dn, 2, 2) + 0.2
End If
Else
Dn.Offset(, 1) = Val(Mid(Dn, 2, 3)) + 20
End If
If IsNumeric(Mid(Dn, 3, 1)) And IsNumeric(Mid(Dn, 4, 1)) Then
If Mid(Dn, 4, 1) = "0" Then
Dn.Offset(, 1) = Mid(Dn, 2, 3) + 20
Else
Dn.Offset(, 1) = Mid(Dn, 2, 3) + 0.2
End If
End If
Input data
*vh105 --> 105.9
*h107 --> 107.8
*l107 --> 107.2
*lm106 --> 106.35
*lm106
*l107
*44
Any help with this problem would be very much be appreciated.
Isolate the Val(Mid(Dn,4,2)) or even the Mid(Dn,4,2) as I think the Val doesnt get a proper numerical string to work with from the Mid function
Use this between line 2 and 3:
Debug.Print Mid(Dn,4,2)
Debug.Print Val(Mid(Dn,4,2))
Let us know what you get in the Immediate Window (if not present go to View > Immediate Window)