Hi All, As im sure youve all heard a million times I new to VBA and I am self teaching myself VBA for work and self betterment.
I set myself a personal project for home rather than always stuff for work to keep a stock of what we have in our multiple freezers. The problem i have is exactly what the subject line is and im sure you guys can spot it straight away. i have adapted some course material and tried to fix myself with google searches etc but you guys are my last resort. forgive me if i do not post in the Correct format as i am a new subscriber even though i've worshipped Bill Jelen for a long time!
The Bolded END IF statement at the end is where the debugger is highlighting My suspicions are multiple Else If statements? The loops somehow, Enlightenment please Thank you in advance for any advice.
Here is the Code:
I set myself a personal project for home rather than always stuff for work to keep a stock of what we have in our multiple freezers. The problem i have is exactly what the subject line is and im sure you guys can spot it straight away. i have adapted some course material and tried to fix myself with google searches etc but you guys are my last resort. forgive me if i do not post in the Correct format as i am a new subscriber even though i've worshipped Bill Jelen for a long time!
The Bolded END IF statement at the end is where the debugger is highlighting My suspicions are multiple Else If statements? The loops somehow, Enlightenment please Thank you in advance for any advice.
Here is the Code:
Rich (BB code):
Option Explicit
Sub FreezerUpdate()
Dim Freezer As String
Dim ItemId As Long
Dim BrandName As String
Dim ProductName As String
Dim Qty As String ' Delivery
Dim Percent As String
Dim KeepSearching As Boolean
Dim RowNum As Long
Dim NewItemID As Long
Dim i As Integer
Dim Id As Integer
Dim NumNewStock As Integer
Range("A2").Select
ActiveCell.FormulaR1C1 = ""
Range("A2").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC[1]&"" ""&RC[2],'Freezer Contents'!C:C[6],2,FALSE),"""")"
Range("A2").Select
Selection.AutoFill Destination:=Range("Table1[ItemID]")
Range("Table1[ItemID]").Select
i = 2
Id = 2
Do Until Cells(i, 2).Value = ""
If Cells(Id, 1).Value = "" Then
' the below section was a recorded macro to sort a column in numeric 'smallest to largest order in order to determine last ItemID
Sheets("Freezer Contents").Select
ActiveWorkbook.Worksheets("Freezer Contents").ListObjects("FreezerContents"). _
Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Freezer Contents").ListObjects("FreezerContents"). _
Sort.SortFields.Add Key:=Range("FreezerContents[[#All],[ItemId]]"), SortOn _
:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Freezer Contents").ListObjects( _
"FreezerContents").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("B2").Select
Selection.End(xlDown).Select
NewItemID = ActiveCell.Value + 1
Sheets("Bought").Select
Cells(Id, 1) = NewItemID
Id = Id + 1
End If
NumNewStock = Application.CountA(Range("A:A")) ' Determines total number of rows to update into Freezer Sheet
Worksheets("Bought").Activate
Do Until Cells(i, 1).Value = ""
ItemId = Cells(i, 1).Value
BrandName = Cells(i, 2).Value
ProductName = Cells(i, 3).Value
Qty = Cells(i, 4).Value
Percent = Cells(i, 5).Value
Freezer = Cells(i, 6).Value
KeepSearching = True
RowNum = 3
Worksheets("Freezer Contents").Activate
Do Until KeepSearching = False
If Cells(RowNum, 2).Value = ItemId Then
If Cells(RowNum, 5).Value <> ("NA") Then
Cells(RowNum, 5).Value = Cells(RowNum, 5).Value + Qty
Cells(RowNum, 6).Value = Cells(RowNum, 6).Value + Percent
ElseIf Cells(RowNum, 2).Value = ItemId Then
If Cells(RowNum, 6).Value = ("NA") Then
KeepSearching = False
ElseIf Cells(RowNum, 1).Value = "" Then
Do Until KeepSearching = False
Cells(RowNum, 2).Value = NewItemID
Cells(RowNum, 3).Value = BrandName
Cells(RowNum, 4).Value = ProductName
Cells(RowNum, 5).Value = Qty
Cells(RowNum, 6).Value = Percent
Cells(RowNum, 7).Value = Freezer
KeepSearching = False
End
RowNum = RowNum + 1
End If
Loop
i = i + 1
Worksheets("Bought").Activate
Loop ' Exterior Loop for the Bought sheet
Loop
Range("A2").Select
Range("A2:F" & NumNewStock).ClearContents
MsgBox "The Freezer Contents has been updated"
End Sub
Last edited by a moderator: