I am a VBA newbie and just started learning about loops.
Here's my code:
sub worksheet_change(byval target as range)
application.screenupdating = false
application.enableevents = false
dim book1 as workbooks
dim customer as range, rang as range, jdiskon as range, pelanggan as range, lookharga as range, diskon as range
dim rout(1 to 10) as variant, i as long
set book1 = workbooks("database.xlsx")
set rang = book1.sheets("DB").range("A6:N84")
set look harga book1.sheets("harga").range("B4:E50")
set pelanggan = range("E7")
set alamat = range("E8")
set jdiskon = range("M26")
set diskon = range("P3")
getalamat = application.worksheetfunction.vlookup(pelanggan, rang, 13, false)
jenisdiskon = application.worksheetfunction.vlookup(pelanggan, rang, 10, false)
getdiskon = application.worksheetfunction.vlookup(pelanggan, rang, 8, false)
getharga = application.worksheetfunction.vlookup(range("D13") & range("E13"), lookharga, 4, false)
getharga1 = application.worksheetfunction.vlookup(range("D14") & range("E14"), lookharga, 4, false)
getharga2 = application.worksheetfunction.vlookup(range("D15") & range("E15"), lookharga, 4, false)
getharga3 = application.worksheetfunction.vlookup(range("D16") & range("E16"), lookharga, 4, false)
getharga4 = application.worksheetfunction.vlookup(range("D17") & range("E17"), lookharga, 4, false)
alamat.value = getalamat
jdiskon.value = jenisdiskon
diskon.value = getdiskon / 100
if jdiskon = "nett" then
range("M13").value = getharga - (getharga * diskon)
range("M14").value = getharga1 - (getharga1 * diskon)
range("M15").value = getharga2 - (getharga2 * diskon)
range("M16").value = getharga3 - (getharga3 * diskon)
range("M17").value = getharga4 - (getharga4 * diskon)
elseif jdiskon.value = "pot" then
range("M13").value = getharga
range("M14").value = getharga1
range("M15").value = getharga2
range("M16").value = getharga3
range("M17").value = getharga4
range("L25").value = diskon
end if
application.enableevents = true
end sub
Right now I'm just using the manual code by copy/pasting. However, I want to simplify the code within the IF by using loops because it seems to be more efficient.
What's the best way to do this?
Write your code like follow:
Dim book1 As Workbooks
Dim customer As Range, rang As Range, jdiskon As Range, pelanggan As Range, lookharga As Range, diskon As Range
Dim rout(1 To 10) As Variant, i As Long
Set book1 = Workbooks("database.xlsx")
Set rang = book1.Sheets("DB").Range("A6:N84")
Set lookharga = book1.Sheets("harga").Range("B4:E50")
Set pelanggan = Range("E7")
Set alamat = Range("E8")
Set jdiskon = Range("M26")
Set diskon = Range("P3")
getalamat = Application.WorksheetFunction.VLookup(pelanggan, rang, 13, False)
jenisdiskon = Application.WorksheetFunction.VLookup(pelanggan, rang, 10, False)
getdiskon = Application.WorksheetFunction.VLookup(pelanggan, rang, 8, False)
'New code with if statement starts from here
alamat.Value = getalamat
jdiskon.Value = jenisdiskon
diskon.Value = getdiskon / 100
For i = 13 To 17
getharga = Application.WorksheetFunction.VLookup(Range("D" & i) & Range("E" & i), lookharga, 4, False)
If jdiskon = "nett" Then
Range("M" & i).Value = getharga - (getharga * diskon)
ElseIf jdiskon.Value = "pot" Then
Range("M" & i).Value = getharga
Range("L25").Value = diskon
End If
' new code with if statement ends here
Next
Application.EnableEvents = True
End Sub
Related
I am struggling with the error subscript out of range at the code:
Set wsCondition = wbCondition.Worksheets(2)
This code is run very well on windows but when I try on MacOS the error occurs. I am a newbie to VBA and I completely do not understand why this error occurs.
Thanks in advance for your guys advice.
Option Explicit
Public Sub btn1_Click()
Dim i As Double
Dim N As Double
Dim strKeyWord As String
Dim myCount As Integer
Dim OrderCount As Integer
Dim SubTotal As Range, Country As Range, DisCount As Range, Quantity As Range, ItemName As Range, OrderName As Range, RequiredData As Range
Dim wsOrder As Worksheet
Dim wsResult As Worksheet
Dim wsCondition As Worksheet
Dim wbOrder As Workbook
Dim wbCondition As Workbook
Dim OrderFile As String
Dim ConditionFile As String
'Open Order wb
OrderFile = Application.GetOpenFilename()
Set wbOrder = Workbooks.Open(OrderFile)
Set wsOrder = wbOrder.Worksheets(1)
'Open Condition wb
ConditionFile = Application.GetOpenFilename()
Set wbCondition = Workbooks.Open(ConditionFile)
Set wsCondition = wbCondition.Worksheets(2)
Set wsResult = wbCondition.Worksheets(1)
With wsResult
.Range("A1").Value = "Product code"
.Range("B1").Value = "Order Condition"
.Range("C1").Value = "Order Name"
.Range("D1").Value = "Subtotal"
.Range("E1").Value = "Discount"
.Range("F1").Value = "Quantity"
.Range("G1").Value = "Item Name"
.Range("H1").Value = "Country"
.Range("A1").Characters(1, 12).Font.Bold = True
.Range("B1").Characters(1, 16).Font.Bold = True
.Range("C1").Characters(1, 16).Font.Bold = True
.Range("D1").Characters(1, 12).Font.Bold = True
.Range("E1").Characters(1, 12).Font.Bold = True
.Range("F1").Characters(1, 12).Font.Bold = True
.Range("G1").Characters(1, 12).Font.Bold = True
.Range("H1").Characters(1, 12).Font.Bold = True
.Range("A1").WrapText = True
.Range("B1").WrapText = True
.Range("C1").WrapText = True
.Range("D1").WrapText = True
.Range("E1").WrapText = True
.Range("F1").WrapText = True
.Range("G1").WrapText = True
.Range("H1").WrapText = True
.Range("A1").ColumnWidth = 13
.Range("A1").RowHeight = 17
.Range("B1").ColumnWidth = 12
.Range("B1").RowHeight = 17
.Range("C1").ColumnWidth = 14.5
.Range("C1").RowHeight = 17
.Range("G1").ColumnWidth = 99
.Range("G1").RowHeight = 17
End With
'using the CountA ws function (all non-blanks)
myCount = Application.CountA(wsCondition.Range("A:A"))
For i = 2 To myCount Step 1
strKeyWord = wsCondition.Range("A" & i)
wsOrder.Range("R:R").AutoFilter Field:=1, Criteria1:="=*" & strKeyWord & "*"
If wsOrder.Cells(Rows.Count, 1).End(xlUp).Row > 1 Then
Set SubTotal = wsOrder.Range("I2", wsOrder.Range("I" & Rows.Count).End(xlUp))
Set Country = wsOrder.Range("AG2", wsOrder.Range("AG" & Rows.Count).End(xlUp))
Set DisCount = wsOrder.Range("N2", wsOrder.Range("N" & Rows.Count).End(xlUp))
Set Quantity = wsOrder.Range("Q2", wsOrder.Range("Q" & Rows.Count).End(xlUp))
Set OrderName = wsOrder.Range("A2", wsOrder.Range("A" & Rows.Count).End(xlUp))
Set ItemName = wsOrder.Range("R2", wsOrder.Range("R" & Rows.Count).End(xlUp))
Set RequiredData = Union(SubTotal, Country, DisCount, Quantity, OrderName, ItemName)
RequiredData.SpecialCells(xlCellTypeVisible).Copy
OrderCount = wsOrder.Range("A2", wsOrder.Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Cells.Count
With wsResult
If OrderCount >= 2 Then
For N = 1 To OrderCount Step 1
.Cells(.Rows.Count, "A").End(xlUp).Offset(1).Value = strKeyWord
.Cells(.Rows.Count, "B").End(xlUp).Offset(1).Value = "Available"
Next N
Else
.Cells(.Rows.Count, "A").End(xlUp).Offset(1).Value = strKeyWord
.Cells(.Rows.Count, "B").End(xlUp).Offset(1).Value = "Available"
End If
.Cells(.Rows.Count, "C").End(xlUp).Offset(1).PasteSpecial
End With
Else
With wsResult
.Cells(.Rows.Count, "A").End(xlUp).Offset(1).Value = strKeyWord
.Cells(.Rows.Count, "B").End(xlUp).Offset(1).Value = "No Order"
.Cells(.Rows.Count, "C").End(xlUp).Offset(1).Value = "N/A"
.Cells(.Rows.Count, "D").End(xlUp).Offset(1).Value = "N/A"
.Cells(.Rows.Count, "E").End(xlUp).Offset(1).Value = "N/A"
End With
End If
OrderCount = 0
Next i
wbCondition.Sheets("Result").Activate
wsOrder.AutoFilterMode = False
End Sub
This has nothing to do whether this code is running on a Mac or Win environment. You have to check if a second worksheet exists in the file you open. In your case you could add following code
If wbCondition.Worksheets.Count > 1 Then
Set wsCondition = wbCondition.Worksheets(2)
else
' Do sth in order to fix the error or end the sub
end if
If you get a subscript out of range it means you tried to access a worksheet that doesn’t exist. This may happen for the following reasons
The worksheet name given to Worksheets is spelled incorrectly.
The name of the worksheet has changed. The worksheet was deleted.
The index was to large e.g. You used Worksheets(5) but there are only four worksheets
The wrong workbook is being used e.g. Workbooks(“book1.xlsx”).Worksheets(“Sheet1”) instead of Workbooks(“book3.xlsx”).Worksheets(“Sheet1”)
You find this here
I want to add many option button to an excel worksheet (not to a VBA-form) and want to group them by row. The result should look something like this:
Here is the code I'm using so far:
For d = 1 To 31
Set checkboxKrankCell = Range("H" + Trim(Str(d)))
Set checkboxUrlaubCell = Range("I" + Trim(Str(d)))
Set checkboxJazCell = Range("J" + Trim(Str(d)))
groupWidth = checkboxKrankCell.Width + checkboxUrlaubCell.Width + checkboxJazCell.Width
Set groupBoxOptionButtons = ActiveSheet.GroupBoxes.Add(checkboxKrankCell.Left - 1, checkboxKrankCell.Top - 2, groupWidth + 1, checkboxKrankCell.Height)
With groupBoxOptionButtons
.Name = "GroupBox_" + Trim(Str(d))
.Caption = ""
End With
Set checkboxKrank = ActiveSheet.OptionButtons.Add(checkboxKrankCell.Left, checkboxKrankCell.Top - 1, checkboxKrankCell.Width, checkboxKrankCell.Height)
With checkboxKrank
.Caption = ""
End With
#1 checkboxKrank.GroupBox = groupBoxOptionButtons
Set checkboxUrlaub = ActiveSheet.OptionButtons.Add(checkboxUrlaubCell.Left, checkboxUrlaubCell.Top - 1, checkboxUrlaubCell.Width, checkboxUrlaubCell.Height)
With checkboxUrlaub
.Caption = ""
End With
Set checkboxJaz = ActiveSheet.OptionButtons.Add(checkboxJazCell.Left, checkboxJazCell.Top - 1, checkboxJazCell.Width, checkboxJazCell.Height)
With checkboxJaz
.Caption = ""
#2 .GroupBox = groupBoxOptionButtons
End With
Next d
I would expect to assign the option buttons to the group for the current row by setting the GroupBox property (see #1 or #2).
But both methods just gave me an error saying 'The object does not support the property or methode'.
Any help or hint is welcome ;-)
Based on the tip from snb I have modified my function like this:
Sub AddOptionButtons()
ActiveSheet.OptionButtons.Delete
For d = 1 To 31
Set checkboxKrankCell = Range("H" + Trim(Str(d + 4)))
Set checkboxUrlaubCell = Range("I" + Trim(Str(d + 4)))
Set checkboxJazCell = Range("J" + Trim(Str(d + 4)))
option1Name = "Krank_" + Trim(Str(d))
option2Name = "Urlaub_" + Trim(Str(d))
option3Name = "Jaz_" + Trim(Str(d))
Set checkboxKrank = ActiveSheet.OptionButtons.Add(checkboxKrankCell.Left, checkboxKrankCell.Top - 1, checkboxKrankCell.Width, checkboxKrankCell.Height)
With checkboxKrank
.Caption = ""
.Name = option1Name
End With
Set checkboxUrlaub = ActiveSheet.OptionButtons.Add(checkboxUrlaubCell.Left, checkboxUrlaubCell.Top - 1, checkboxUrlaubCell.Width, checkboxUrlaubCell.Height)
With checkboxUrlaub
.Caption = ""
.Name = option2Name
End With
Set checkboxJaz = ActiveSheet.OptionButtons.Add(checkboxJazCell.Left, checkboxJazCell.Top - 1, checkboxJazCell.Width, checkboxJazCell.Height)
With checkboxJaz
.Caption = ""
.Name = option3Name
End With
ActiveSheet.Shapes.Range(Array(option1Name, option2Name, option3Name)).Group
Next d
End Sub
I don't get any errors using Shapes.Range(...).Group.
But still all option buttons from on the sheet are all mutual exclusive.
Seems grouping does not work here.
Try the following code on an empty workbook. It will give you an option to choose only ONE optionbutton on each row, which is what you want, as far as I understood (I also created a linked cell reference, just in case you would like to take further action, given the choice of a user.):
Sub AddOptionButtons()
Dim btn1 As OptionButton
Dim btn2 As OptionButton
Dim btn3 As OptionButton
Dim grbox As GroupBox
Dim t As Range
Dim s As Range
Dim p As Range
Dim i As Integer
ActiveSheet.OptionButtons.Delete
ActiveSheet.GroupBoxes.Delete
For i = 5 To 35 Step 1
Set t = ActiveSheet.Range(Cells(i, 8), Cells(i, 8))
Set s = ActiveSheet.Range(Cells(i, 9), Cells(i, 9))
Set p = ActiveSheet.Range(Cells(i, 10), Cells(i, 10))
Set btn1 = ActiveSheet.OptionButtons.Add(t.Left, t.Top, t.Width, t.Height)
Set btn2 = ActiveSheet.OptionButtons.Add(s.Left, s.Top, s.Width, s.Height)
Set btn3 = ActiveSheet.OptionButtons.Add(p.Left, p.Top, p.Width, p.Height)
Set grbox = ActiveSheet.GroupBoxes.Add(t.Left, t.Top, t.Width + 100, t.Height)
With btn1
.Caption = ""
.Display3DShading = True
.LinkedCell = "M" & i
End With
With btn2
.Caption = ""
.Display3DShading = True
End With
With btn3
.Caption = ""
.Display3DShading = True
End With
With grbox
.Caption = ""
.Visible = False
End With
Next i
End Sub
I'd use:
Sub M_snb()
ReDim sn(2)
For j = 1 To 2
For jj = 1 To 3
With Sheet1.OptionButtons.Add(Cells(j, jj).Left, Cells(j, jj).Top - 1, Cells(j, jj).Width, Cells(j, jj).Height)
sn(jj - 1) = .Name
End With
Next
Sheet1.Shapes.Range(sn).Group
Next
End Sub
I extracted the values of each cell from the table in word document, and I created charts based on those values. The charts are fine.
However, it keep insert at the first page. Does anyone know how can I insert my chart in at same position in each page?
The word document generated by Mail Merge. Will that cause the problem?
Also, dose anyone know how to insert a chart into table cell?
Dim pge As Page
Dim i As Integer
i = 3
Dim j As Integer
j = 1
For peg = 1 To Selection.Information(wdNumberOfPagesInDocument)
Dim tTable As Table
Set tTable = ActiveDocument.Tables(i)
Set cTable = ActiveDocument.Tables(j)
Dim wChart As Chart
Dim chartWorkSheet As Excel.Worksheet
Dim ThisYrSumCon As Integer
Dim ThisYrWinCon As Integer
Dim PreYrSumCon As Integer
Dim PreYrWinCon As Integer
Dim BefPreYrSumCon As Integer
Dim BefPreYrWinCon As Integer
'•
ThisYrSumCon = CInt(Left(tTable.Cell(2, 2).Range.Text, Len(tTable.Cell(3, 2).Range.Text)))
ThisYrWinCon = CInt(Left(tTable.Cell(3, 2).Range.Text, Len(tTable.Cell(3, 2).Range.Text) - 1))
PreYrSumCon = CInt(Left(tTable.Cell(2, 3).Range.Text, Len(tTable.Cell(3, 2).Range.Text)))
PreYrWinCon = CInt(Left(tTable.Cell(3, 3).Range.Text, Len(tTable.Cell(3, 2).Range.Text)))
BePreYrSumCon = CInt(Left(tTable.Cell(2, 4).Range.Text, Len(tTable.Cell(3, 2).Range.Text)))
BePreYrWinCon = CInt(Left(tTable.Cell(3, 4).Range.Text, Len(tTable.Cell(3, 2).Range.Text)))
'MsgBox (ThisYrSumCon)
'cTable.Cell(3, 4).Range.Text = "test"
'cTable.Cell(12, 3).Range.Text = "test"
Set wChart = ActiveDocument.Shapes.AddChart.Chart
With wChart.Parent
.Top = 105
.Left = 205
.Width = 300
.Height = 150
End With
Set chartWorkSheet = wChart.ChartData.Workbook.WorkSheets(1)
chartWorkSheet.ListObjects("Table1").Resize chartWorkSheet.Range("A1:G2")
chartWorkSheet.Range("Table1[[#Headers],[Series 1]]").FormulaR1C1 = "Water Consumption Records"
wChart.ChartType = xlColumnClustered
chartWorkSheet.Range("A1").FormulaR1C1 = ""
chartWorkSheet.Range("B1").FormulaR1C1 = "2012 Summer"
chartWorkSheet.Range("C1").FormulaR1C1 = "2012 Winter"
chartWorkSheet.Range("D1").FormulaR1C1 = "2013 Summer"
chartWorkSheet.Range("E1").FormulaR1C1 = "2013 Winter"
chartWorkSheet.Range("F1").FormulaR1C1 = "2014 Summer"
chartWorkSheet.Range("G1").FormulaR1C1 = "2014 Winter"
chartWorkSheet.Range("A2").FormulaR1C1 = ""
chartWorkSheet.Range("B2").FormulaR1C1 = BePreYrSumCon
chartWorkSheet.Range("C2").FormulaR1C1 = BePreYrWinCon
chartWorkSheet.Range("D2").FormulaR1C1 = PreYrSumCon
chartWorkSheet.Range("E2").FormulaR1C1 = PreYrWinCon
chartWorkSheet.Range("F2").FormulaR1C1 = ThisYrSumCon
chartWorkSheet.Range("G2").FormulaR1C1 = ThisYrWinCon
wChart.ChartData.Workbook.Application.Quit
i = i + 5
j = j + 5
Selection.GoTo What:=wdGoToPage, Which:=lNextPage
Next
Lol, I am so happy that I can answer my own question... :)
Here's the answer for creating a chart base on the same format word table in each page, and put the chart at same spot each page.
The i Integer is for me to find the same table in each page.
Dim Rng As Range, pg As Long
Dim i As Integer
i = 3
With ActiveDocument
Set Rng = .Range(0, 0)
For pg = 1 To .ComputeStatistics(wdStatisticPages)
Set Rng = Rng.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=pg)
Rng.Collapse wdCollapseStart
Dim tTable As Table
Set tTable = ActiveDocument.Tables(i)
Dim wChart As Chart
Dim chartWorkSheet As Excel.Worksheet
Dim ThisYrSumCon As Integer
Dim ThisYrWinCon As Integer
Dim PreYrSumCon As Integer
Dim PreYrWinCon As Integer
Dim BefPreYrSumCon As Integer
Dim BefPreYrWinCon As Integer
ThisYrSumCon = CInt(Left(tTable.Cell(2, 2).Range.Text, Len(tTable.Cell(2, 2).Range.Text) - 1))
ThisYrWinCon = CInt(Left(tTable.Cell(3, 2).Range.Text, Len(tTable.Cell(3, 2).Range.Text) - 1))
PreYrSumCon = CInt(Left(tTable.Cell(2, 3).Range.Text, Len(tTable.Cell(2, 3).Range.Text) - 1))
PreYrWinCon = CInt(Left(tTable.Cell(3, 3).Range.Text, Len(tTable.Cell(3, 3).Range.Text) - 1))
BePreYrSumCon = CInt(Left(tTable.Cell(2, 4).Range.Text, Len(tTable.Cell(2, 4).Range.Text) - 1))
BePreYrWinCon = CInt(Left(tTable.Cell(3, 4).Range.Text, Len(tTable.Cell(3, 4).Range.Text) - 1))
Set wChart = .Shapes.AddChart(xlColumnClustered, 270, 105, 230, 150, Rng).Chart
Set chartWorkSheet = wChart.ChartData.Workbook.WorkSheets(1)
chartWorkSheet.ListObjects("Table1").Resize chartWorkSheet.Range("A1:G2")
chartWorkSheet.Range("Table1[[#Headers],[Series 1]]").FormulaR1C1 = "Water Consumption Records"
chartWorkSheet.Range("A1").FormulaR1C1 = ""
chartWorkSheet.Range("B1").FormulaR1C1 = "2012 Summer"
chartWorkSheet.Range("C1").FormulaR1C1 = "2012 Winter"
chartWorkSheet.Range("D1").FormulaR1C1 = "2013 Summer"
chartWorkSheet.Range("E1").FormulaR1C1 = "2013 Winter"
chartWorkSheet.Range("F1").FormulaR1C1 = "2014 Summer"
chartWorkSheet.Range("G1").FormulaR1C1 = "2014 Winter"
chartWorkSheet.Range("A2").FormulaR1C1 = ""
chartWorkSheet.Range("B2").FormulaR1C1 = BePreYrSumCon
chartWorkSheet.Range("C2").FormulaR1C1 = BePreYrWinCon
chartWorkSheet.Range("D2").FormulaR1C1 = PreYrSumCon
chartWorkSheet.Range("E2").FormulaR1C1 = PreYrWinCon
chartWorkSheet.Range("F2").FormulaR1C1 = ThisYrSumCon
chartWorkSheet.Range("G2").FormulaR1C1 = ThisYrWinCon
wChart.ChartData.Workbook.Application.Quit
i = i + 5
j = j + 5
Next
End With
I am writing an excel vba sub routine that sums up lbs purchased by customer per year, but for some reason the subroutine is failing. It prints out all of the customer names in the column B as it should but for the year 2011 it prints all 0's in that row and for 2012, 2013, and 2014 it prints 0's in the first column and thats it.
Private Sub lbsPerCustPerYear_Click()
Dim i As Integer
Dim Cust As Range
Dim Cust2 As Range
Dim Total2011 As Long
Dim Total2012 As Long
Dim Total2013 As Long
Dim Total2014 As Long
Dim Output As Range
Dim OutputY2011 As Range
Dim OutputY2012 As Range
Dim OutputY2013 As Range
Dim OutputY2014 As Range
Dim CustLbs As Range
Dim Cust2Lbs As Range
Dim YearD As Range
Total = 0
Set Cust = Range("C6")
Set Cust2 = Range("C7")
Set CustLbs = Range("Q6")
Set Cust2Lbs = Range("Q7")
Set Output = Sheets("Sheet10").Cells(2, 2)
Set OutputY2011 = Sheets("Sheet10").Cells(2, 3)
Set OutputY2012 = Sheets("Sheet10").Cells(2, 4)
Set OutputY2013 = Sheets("Sheet10").Cells(2, 5)
Set OutputY2014 = Sheets("Sheet10").Cells(2, 6)
Set YearD = Range("K6")
For i = 0 To 14750
If IsDate(Sheets("Sheet1").Cells(6 + i, 11)) And IsNumeric(Sheets("Sheet1").Cells(6 + i, 17)) Then
If Year(YearD) = "2011" Then
Total2011 = Total2011 + CustLbs.Value
Output.Value = Cust.Value
OutputY2011.Value = Total
ElseIf Year(YearD) = "2012" Then
Total2012 = Total2012 + CustLbs.Value
Output.Value = Cust.Value
OutputY2012.Value = Total
ElseIf Year(YearD) = "2013" Then
Total2013 = Total2013 + CustLbs.Value
Output.Value = Cust.Value
OutputY2013.Value = Total
ElseIf Year(YearD) = "2014" Then
Total2014 = Total2014 + CustLbs.Value
Output.Value = Cust.Value
OutputY2014.Value = Total
End If
If Cust.Value = Cust2.Value Then
Set Cust = Cust.Offset(1, 0)
Set Cust2 = Cust2.Offset(1, 0)
Set CustLbs = CustLbs.Offset(1, 0)
Set Cust2Lbs = Cust2Lbs.Offset(1, 0)
Set YearD = YearD.Offset(1, 0)
Else
Set Cust = Cust.Offset(1, 0)
Set Cust2 = Cust2.Offset(1, 0)
Set CustLbs = CustLbs.Offset(1, 0)
Set Cust2Lbs = Cust2Lbs.Offset(1, 0)
Set Output = Output.Offset(1, 0)
Set OutputY2011 = OutputY2011.Offset(1, 0)
Set OutputY2012 = OutputY2011.Offset(1, 0)
Set OutputY2013 = OutputY2011.Offset(1, 0)
Set OutputY2014 = OutputY2011.Offset(1, 0)
Set YearD = YearD.Offset(1, 0)
Total2011 = 0
Total2012 = 0
Total2013 = 0
Total2014 = 0
End If
Else
Set Cust = Cust.Offset(1, 0)
Set Cust2 = Cust2.Offset(1, 0)
Set CustLbs = CustLbs.Offset(1, 0)
Set Cust2Lbs = Cust2Lbs.Offset(1, 0)
Set YearD = YearD.Offset(1, 0)
End If
Next i
End Sub
Any help as to why this is happening would be greatly appreciated.
I would start by using a MsgBox to verify your variables through each iteration. You may be able to pinpoint the problem this way.
MsgBox (Cust & " " & Cust2 & " " & Total2011)
You define Total = 0 but then never change it before writing the value to your range here: OutputY2011.Value = Total
Your code appears to use a different total variable (i.e. Total2011) for each year instead: Try changing your output like this (last line is the one I changed):
For i = 0 To 14750
If IsDate(Sheets("Sheet1").Cells(6 + i, 11)) And IsNumeric(Sheets("Sheet1").Cells(6 + i, 17)) Then
If Year(YearD) = "2011" Then
Total2011 = Total2011 + CustLbs.Value
Output.Value = Cust.Value
OutputY2011.Value = Total2011
I can't make the error go away, it only turns into a different error. The IF at the top is ended. The FORs all align. If I add an 'End IF' before "End Sub", I get the error "for without next".
Here is my code:
Sub Updatevalue()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim ws4 As Worksheet
wbname1 = Range("IllustWBDir1")
Set wb1 = Application.Workbooks.Open(wbname1)
ThisWorkbook.Activate
For Item = 0 To Sheets("Documentation").ListBox1.ListCount - 1
If Sheets("Documentation").ListBox1.Selected(Item) = True Then
If Sheets("Documentation").ListBox1.List(Item) = "Compact" Then
Range("Statename") = "MA"
stname = "C"
Else
Range("Statename") = Sheets("Documentation").ListBox1.List(Item)
stname = Range("Statename")
End If
Range("Statename").Copy
wb1.Activate
Sheets("Inputs").Select
Range("State").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.Calculate
Set ws1 = wb1.Sheets("PPGs")
Set tb1 = ws1.Range("PPG_Table")
ThisWorkbook.Activate
Base_Schematic = ThisWorkbook.Names("Base_Schematic").RefersToRange
' Key Ages
Dim ages(1 To 8) As String
ages(1) = "30"
ages(2) = "40"
ages(3) = "50"
ages(4) = "55"
ages(5) = "60"
ages(6) = "65"
ages(7) = "70"
ages(8) = "75"
' Gender
Dim uniorgd(1 To 3) As String
uniorgd(1) = "U"
uniorgd(2) = "F"
uniorgd(3) = "M"
' Bps
Dim Bps(1 To 6) As String
Bps(1) = "1"
Bps(2) = "2"
Bps(3) = "3"
Bps(4) = "4"
Bps(5) = "5"
Bps(6) = "6"
' UW Classes
Dim UWs(1 To 4) As String
UWs(1) = "P"
UWs(2) = "S"
UWs(4) = "1"
UWs(5) = "2"
' Marital Status
Dim Mar(1 To 2) As String
Mar(1) = "S"
Mar(2) = "M"
' Inflations
Dim Infls(1 To 2) As String
Infls(1) = "3C_PPG"
Infls(2) = "5C_PPG"
For a = 1 To 8
For b = 1 To 3
For c = 1 To 6
For d = 1 To 4
For e = 1 To 2
For f = 1 To 2
findval = ages(a) & uniorgd(b) & Bps(c) & UWs(d) & Mar(e) & Infls(f)
wb1.Activate
Sheets("PPGs").Select
pasteval = Application.WorksheetFunction.VLookup(Right(findval, 10), Range("PPG_Table"), Range("2,84"), False)
Next f
Next e
Next d
Next c
Next b
Next a
End Sub
You seem to be missing Next for the first For and End If for the First If
since you understand the logic, you should be able to place them appropriately.
Sub Updatevalue()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim ws4 As Worksheet
wbname1 = Range("IllustWBDir1")
Set wb1 = Application.Workbooks.Open(wbname1)
ThisWorkbook.Activate
For Item = 0 To Sheets("Documentation").ListBox1.ListCount - 1
If Sheets("Documentation").ListBox1.Selected(Item) = True Then
If Sheets("Documentation").ListBox1.List(Item) = "Compact" Then
Range("Statename") = "MA"
stname = "C"
Else
Range("Statename") = Sheets("Documentation").ListBox1.List(Item)
stname = Range("Statename")
End If
Range("Statename").Copy
wb1.Activate
Sheets("Inputs").Select
Range("State").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.Calculate
Set ws1 = wb1.Sheets("PPGs")
Set tb1 = ws1.Range("PPG_Table")
ThisWorkbook.Activate
Base_Schematic = ThisWorkbook.Names("Base_Schematic").RefersToRange
' Key Ages
Dim ages(1 To 8) As String
ages(1) = "30"
ages(2) = "40"
ages(3) = "50"
ages(4) = "55"
ages(5) = "60"
ages(6) = "65"
ages(7) = "70"
ages(8) = "75"
' Gender
Dim uniorgd(1 To 3) As String
uniorgd(1) = "U"
uniorgd(2) = "F"
uniorgd(3) = "M"
' Bps
Dim Bps(1 To 6) As String
Bps(1) = "1"
Bps(2) = "2"
Bps(3) = "3"
Bps(4) = "4"
Bps(5) = "5"
Bps(6) = "6"
' UW Classes
Dim UWs(1 To 4) As String
UWs(1) = "P"
UWs(2) = "S"
UWs(4) = "1"
UWs(5) = "2"
' Marital Status
Dim Mar(1 To 2) As String
Mar(1) = "S"
Mar(2) = "M"
' Inflations
Dim Infls(1 To 2) As String
Infls(1) = "3C_PPG"
Infls(2) = "5C_PPG"
For a = 1 To 8
For b = 1 To 3
For c = 1 To 6
For d = 1 To 4
For e = 1 To 2
For f = 1 To 2
findval = ages(a) & uniorgd(b) & Bps(c) & UWs(d) & Mar(e) & Infls(f)
wb1.Activate
Sheets("PPGs").Select
pasteval = Application.WorksheetFunction.VLookup(Right(findval, 10), Range("PPG_Table"), Range("2,84"), False)
Next f
Next e
Next d
Next c
Next b
Next a
End If
Next
End Sub
This is one of the good reason to properly indent your code !
The first For and the first If have no Next and End If.
One way to avoid this kind of problems is to write the end statement right after you write the conditions statement, and then you move inside the cicle and write the code.