GriffintheGuy
New Member
- Joined
- Sep 6, 2018
- Messages
- 2
Oh boy. So I'm new to VBA entirely and I made a rudimentary inventory program in PC using VBA. I tried it out on Mac and it didn't work at all. I am not even sure where to begin the process of coding it to work for Mac. It's a gift for my Mom so I hope one of y'all is smart enough to point me in the right direction.
here is the code so far:
This is all in the UserForm called ufmAcct:
Here are the subs of the two related modules that create the message boxes
- AND -
Also here is the rest of the code for the AlwaysTop feature:
I would appreciate any help you can give. Thanks.
here is the code so far:
This is all in the UserForm called ufmAcct:
Code:
Sub btnCloseBought_Click()
'code for the close button on the first page. can probably just duplicate
ufmAcct.Hide
Application.Visible = True
ThisWorkbook.Save
Call Sheet1.Sheet_Formatting
Application.Visible = True
End Sub
Private Sub btnCloseReturned_Click()
'code for the close button on the first page. can probably just duplicate
ufmAcct.Hide
Application.Visible = True
ThisWorkbook.Save
Call Sheet1.Sheet_Formatting
Application.Visible = True
End Sub
Sub btnCloseSold_Click()
'code for the close button on the first page. can probably just duplicate
ufmAcct.Hide
Application.Visible = True
ThisWorkbook.Save
Call Sheet1.Sheet_Formatting
Application.Visible = True
End Sub
Private Sub btnInventoryAdj_Click()
'formats Journal Entry
Sheet2.Select
Range("A" & Rows.Count).End(xlUp).Select
Selection.End(xlToRight).Select
Selection.Offset(-17, 1).Select
With Selection
.Borders.LineStyle = xlContinuous
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
On Error Resume Next
Selection.Value = 1
Selection.Value = Selection.Offset(0, -1).Value + 1
Selection.Offset(17, 0).Select
With Selection
.Borders.LineStyle = xlContinuous
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Value = 0
End With
Range(Cells(Selection.Row - 1, Selection.Column), Cells(Selection.Row - 16, Selection.Column)).Select
With Selection
.NumberFormat = "#,##0.00_);[Red](#,##0.00)"
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
'debit Loss
Lastcol = ThisWorkbook.Sheets("Trial Balance").Cells(3, Columns.Count).End(xlToLeft)
For Each X In Sheet2.Range("pt_LoA")
If X = "Loss" Then
For Each jim In Sheet1.Range("pt_NoI")
If jim = ufmAcct.cmbIAdj.Value Then
X.Offset(0, Lastcol + 1).Value = Sheet1.Cells(jim.Row, 2)
End If
Next jim
End If
Next X
'Credit COGS
For Each X In Range("pt_LoA")
If X = "Inventory" Then
For Each jim In Sheet1.Range("pt_NoI")
If jim = ufmAcct.cmbIAdj.Value Then
X.Offset(0, Lastcol + 1).Value = -Sheet1.Cells(jim.Row, 2)
End If
Next jim
End If
Next X
For Each dude In Sheet1.Range("pt_NoI")
If dude.Value = ufmAcct.cmbIAdj.Value Then
dude.Font.Strikethrough = True
dude.Font.Color = -16776961
dude.Offset(0, 1).Font.Strikethrough = True
dude.Offset(0, 1).Font.Color = -16776961
dude.Offset(0, 2).Font.Strikethrough = True
dude.Offset(0, 2).Font.Color = -16776961
dude.Offset(0, 3).Font.Strikethrough = True
dude.Offset(0, 3).Font.Color = -16776961
dude.Offset(0, 4).Font.Strikethrough = True
dude.Offset(0, 4).Font.Color = -16776961
dude.Offset(0, 5).Font.Strikethrough = True
dude.Offset(0, 5).Font.Color = -16776961
dude.Offset(0, 6).Font.Strikethrough = True
dude.Offset(0, 6).Font.Color = -16776961
dude.Offset(0, 7).Value = dude.Offset(0, 7).Value & _
" " & ufmAcct.tbDeetsIA.Value & " Marked as Loss"
End If
Next dude
'clear form
ufmAcct.cmbIAdj.Value = ""
ufmAcct.tbDeetsIA.Value = ""
End Sub
Sub btnSubBought_Click()
'working: runs the submission data entry for a new inventory item
ThisWorkbook.Sheets("Running Inventory").Select
Range("A" & Rows.Count).End(xlUp).Select
With Selection
.Offset(1, 0) = tbIN.Value
.Offset(1, 2) = tbSize.Value
.Offset(1, 3) = tbBrand.Value
.Offset(1, 5) = "In Inventory"
.Offset(1, 7) = ufmAcct.tbDeetsB.Value
End With
Columns("H").EntireColumn.Hidden = True
Selection.Offset(1, 1).Select
With Selection
.Value = ufmAcct.tbPricePd.Value
End With
'finds latest entry
Sheets(3).Select
Range("A" & Rows.Count).End(xlUp).Select
Selection.End(xlToRight).Select
Selection.Offset(-17, 1).Select
With Selection
.Borders.LineStyle = xlContinuous
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
Selection.Offset(18, 0).Value = "Purchased inventory item:" & " " & ufmAcct.tbIN.Value
End With
On Error Resume Next
Selection.Value = 1
Selection.Value = Selection.Offset(0, -1).Value + 1
Selection.Offset(17, 0).Select
With Selection
.Borders.LineStyle = xlContinuous
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Value = 0
End With
Range(Cells(Selection.Row - 1, Selection.Column), Cells(Selection.Row - 16, Selection.Column)).Select
With Selection
.NumberFormat = "#,##0.00_);[Red](#,##0.00)"
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
'debit the inventory
Lastcol = ThisWorkbook.Sheets("Trial Balance").Cells(3, Columns.Count).End(xlToLeft)
For Each blah In Range("pt_LoA")
If blah = "Inventory" Then
blah.Offset(0, Lastcol + 1) = tbPricePd.Value
End If
Next blah
If cboxCC.Value = True Then GoTo ccard
'credit the cash
For Each blah In Range("pt_LoA")
If blah = "Cash" Then
blah.Offset(0, Lastcol + 1) = -tbPricePd.Value
End If
Next blah
If cboxCC.Value = False Then GoTo Clear
ccard:
'credits the cc
For Each blah In Range("pt_LoA")
If blah = "Accts Payable" Then
blah.Offset(0, Lastcol + 1) = -tbPricePd.Value
End If
Next blah
Clear:
'clears selections
With ufmAcct
.tbIN.Value = ""
.tbPricePd.Value = ""
.tbSize.Value = ""
.tbBrand.Value = ""
.cboxCC.Value = False
.tbDeetsB.Value = ""
End With
End Sub
Sub btnSubReturned_Click()
'changes status to returned inventory and formats
For Each blah In Sheet1.Range("pt_NoI")
If blah = ufmAcct.cmbReturned.Value And blah.Offset(0, 5).Value = "Sold" Then
blah.Offset(0, 5).Value = "Returned Inventory"
blah.Offset(0, 5).Font.Color = -16776961
blah.Offset(0, 7).Value = blah.Offset(0, 7).Value & " " & ufmAcct.tbDeetsIR
End If
Next blah
'formats Journal Entry
Sheet2.Select
Range("A" & Rows.Count).End(xlUp).Select
Selection.End(xlToRight).Select
Selection.Offset(1, 1).Value = "item: " & ufmAcct.cmbReturned.Value & " was returned"
Selection.Offset(-17, 1).Select
With Selection
.Borders.LineStyle = xlContinuous
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
On Error Resume Next
Selection.Value = 1
Selection.Value = Selection.Offset(0, -1).Value + 1
Selection.Offset(17, 0).Select
With Selection
.Borders.LineStyle = xlContinuous
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Value = 0
End With
Range(Cells(Selection.Row - 1, Selection.Column), Cells(Selection.Row - 16, Selection.Column)).Select
With Selection
.NumberFormat = "#,##0.00_);[Red](#,##0.00)"
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
'debit Sales
Lastcol = ThisWorkbook.Sheets("Trial Balance").Cells(3, Columns.Count).End(xlToLeft)
For Each blah In Range("pt_LoA")
If blah = "Sales" Then
blah.Offset(0, Lastcol + 1) = tbRCost.Value
End If
Next blah
'credit Cash
For Each blah In Range("pt_LoA")
If blah = "Cash" Then
blah.Offset(0, Lastcol + 1) = -tbRCost.Value
End If
Next blah
'debit Inventory
Lastcol = ThisWorkbook.Sheets("Trial Balance").Cells(3, Columns.Count).End(xlToLeft)
For Each X In Range("pt_LoA")
If X = "Inventory" Then
For Each jim In Sheet1.Range("tbl_RI")
If jim = ufmAcct.cmbReturned.Value Then
X.Offset(0, Lastcol + 1).Value = Sheet1.Cells(jim.Row, 2)
End If
Next jim
End If
Next X
'Credit COGS
Lastcol = ThisWorkbook.Sheets("Trial Balance").Cells(3, Columns.Count).End(xlToLeft)
For Each X In Range("pt_LoA")
If X = "Cost of Sales" Then
For Each jim In Sheet1.Range("tbl_RI")
If jim = ufmAcct.cmbReturned.Value Then
X.Offset(0, Lastcol + 1).Value = -Sheet1.Cells(jim.Row, 2)
End If
Next jim
End If
Next X
Clear:
'clears selections
With ufmAcct
.cmbReturned.Value = ""
.tbRCost.Value = ""
.tbDTR.Value = Date
.tbDeetsIR.Value = ""
End With
End Sub
Sub btnSubSold_Click()
'needs to imput price sold for and mark items as sold/not in inventory
For Each blah In Range("pt_NoI")
If blah = ufmAcct.cmbSoldItems.Value And blah.Offset(0, 5).Value = "In Inventory" Then
blah.Offset(0, 4).Value = ufmAcct.tbPriceSD.Value
blah.Offset(0, 5).Value = "Sold"
blah.Offset(0, 6).Value = CDate(ufmAcct.tbDTSD.Value)
blah.Offset(0, 7).Value = blah.Offset(0, 7).Value & " " & ufmAcct.tbDeetsS.Value
End If
Next blah
'finds latest entry plus some formatting
Sheets(3).Select
Range("A" & Rows.Count).End(xlUp).Select
Selection.End(xlToRight).Select
Selection.Offset(1, 1).Value = "Item: " & ufmAcct.cmbSoldItems.Value & " was sold."
Selection.Offset(-17, 1).Select
With Selection
.Borders.LineStyle = xlContinuous
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
On Error Resume Next
Selection.Value = 1
Selection.Value = Selection.Offset(0, -1).Value + 1
Selection.Offset(17, 0).Select
With Selection
.Borders.LineStyle = xlContinuous
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Value = 0
End With
Range(Cells(Selection.Row - 1, Selection.Column), Cells(Selection.Row - 16, Selection.Column)).Select
With Selection
.NumberFormat = "#,##0.00_);[Red](#,##0.00)"
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
'debit the Cash
Lastcol = ThisWorkbook.Sheets("Trial Balance").Cells(3, Columns.Count).End(xlToLeft)
For Each blah In Range("pt_LoA")
If blah = "Cash" Then
blah.Offset(0, Lastcol + 1) = tbPriceSD.Value
End If
Next blah
'credits the Sales
For Each blah In Range("pt_LoA")
If blah = "Sales" Then
blah.Offset(0, Lastcol + 1) = -tbPriceSD.Value
End If
Next blah
'debit the COGS
Lastcol = ThisWorkbook.Sheets("Trial Balance").Cells(3, Columns.Count).End(xlToLeft)
For Each X In Range("pt_LoA")
If X = "Cost of Sales" Then
For Each jim In Sheet1.Range("tbl_RI")
If jim = ufmAcct.cmbSoldItems.Value Then
X.Offset(0, Lastcol + 1).Value = Sheet1.Cells(jim.Row, 2)
End If
Next jim
End If
Next X
'credits the inventory
Lastcol = ThisWorkbook.Sheets("Trial Balance").Cells(3, Columns.Count).End(xlToLeft)
For Each X In Range("pt_LoA")
If X = "Inventory" Then
For Each jim In Sheet1.Range("tbl_RI")
If jim = ufmAcct.cmbSoldItems.Value Then
X.Offset(0, Lastcol + 1).Value = -Sheet1.Cells(jim.Row, 2)
End If
Next jim
End If
Next X
'clears form
ufmAcct.cmbSoldItems.Value = ""
ufmAcct.tbPriceSD.Value = ""
ufmAcct.tbDTSD.Value = Date
ufmAcct.tbDeetsS.Value = ""
End Sub
Private Sub cmbJER_Click()
'formats journal entry
Sheet2.Select
Range("A" & Rows.Count).End(xlUp).Select
Selection.End(xlToRight).Select
Selection.Offset(-17, 1).Select
With Selection
.Borders.LineStyle = xlContinuous
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
On Error Resume Next
Selection.Value = 1
Selection.Value = Selection.Offset(0, -1).Value + 1
Selection.Offset(18, 0).Value = ufmAcct.tbDeetsJER
Selection.Offset(17, 0).Select
With Selection
.Borders.LineStyle = xlContinuous
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Value = 0
End With
Range(Cells(Selection.Row - 1, Selection.Column), Cells(Selection.Row - 16, Selection.Column)).Select
With Selection
.NumberFormat = "#,##0.00_);[Red](#,##0.00)"
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
If ufmAcct.CboxRecon.Value = True Then
Selection.Interior.Color = RGB(255, 165, 0)
Selection.Borders.LineStyle = xlContinuous
Else
Resume Next
End If
'debits selected Acct
Lastcol = ThisWorkbook.Sheets("Trial Balance").Cells(3, Columns.Count).End(xlToLeft)
For Each X In Range("pt_LoA")
If X = ufmAcct.cmbDebit Then
X.Offset(0, Lastcol + 1).Value = ufmAcct.tbAmount.Value
End If
Next X
'credits selected Acct
For Each X In Range("pt_LoA")
If X = ufmAcct.cmbCredit Then
X.Offset(0, Lastcol + 1).Value = -ufmAcct.tbAmount.Value
End If
Next X
'clears form
ufmAcct.cmbCredit.Value = ""
ufmAcct.cmbDebit.Value = ""
ufmAcct.tbAmount.Value = ""
ufmAcct.tbDeetsJER.Value = ""
End Sub
Private Sub CommandButton6_Click()
'clears out empty entries
Call Sheet1.Sheet_Formatting
ufmAcct.Hide
Application.Visible = True
ThisWorkbook.Save
End Sub
Private Sub MultiPage1_Change()
'stops overload issue for Sold Inventory
If Not MultiPage1.Value = 1 Then
ufmAcct.cmbSoldItems.Clear
Else
For Each blah In Sheet1.Range("pt_NoI")
If blah.Offset(0, 5).Value = "In Inventory" Or blah.Offset(0, 5).Value = "Returned Inventory" Then
ufmAcct.cmbSoldItems.AddItem blah
End If
Next blah
End If
'stops overload issue for returns
If Not MultiPage1.Value = 2 Then
ufmAcct.cmbReturned.Clear
Else
For Each blah In Range("pt_NoI")
If blah.Offset(0, 5).Value = "Sold" And blah.Offset(0, 6) > DateAdd("d", -7, Date) Then
ufmAcct.cmbReturned.AddItem blah
End If
Next blah
End If
If Not MultiPage1.Value = 3 Then
ufmAcct.cmbIAdj.Clear
Else
For Each blah In Sheet1.Range("pt_NoI")
ufmAcct.cmbIAdj.AddItem blah
Next blah
End If
End Sub
Private Sub MultiPage2_Change()
If Not MultiPage2.Value = 0 Then
ufmAcct.cmbIAdj.Clear
Else
For Each blah In Sheet1.Range("pt_NoI")
ufmAcct.cmbIAdj.AddItem blah
Next blah
End If
End Sub
Sub UserForm_Initialize()
ufmAcct.tbDTSD.Value = Date
ufmAcct.tbDTR.Value = Date
ufmAcct.tbNoReturns.Value = "No Returns Before This Date:" & Date - 7
MultiPage1.Value = 0
'always on top
AlwaysOnTop Me.caption
AddButtons Me.caption, WS_MINIMIZEBOX 'minimise box only
'AddButtons Me.caption, WS_MINIMIZEBOX Or WS_MAXIMIZEBOX 'minimise and maximise boxes
End Sub
Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
ufmAcct.Hide
Call Sheet1.Sheet_Formatting
Excel.ThisWorkbook.SaveAs
Application.Visible = True
End Sub
Private Sub AlwaysOnTop(caption As String)
'all following code places on top
Dim hWnd As Long, lResult As Long
If Val(Application.Version) >= 9 Then
hWnd = FindWindow("ThunderDFrame", caption)
Else
hWnd = FindWindow("ThunderXFrame", caption)
End If
If hWnd <> 0 Then
lResult = SetWindowPos(hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
Else
MsgBox "AlwaysOnTop: userform with caption '" & caption & "' not found"
End If
End Sub
Private Sub AddButtons(caption As String, buttonStyle As Long)
Dim hWnd As Long, lstyle As Long, lResult As Long
If Val(Application.Version) >= 9 Then
hWnd = FindWindow("ThunderDFrame", caption)
Else
hWnd = FindWindow("ThunderXFrame", caption)
End If
If hWnd <> 0 Then
lstyle = GetWindowLong(hWnd, GWL_STYLE)
lstyle = lstyle Or WS_SYSMENU Or buttonStyle
'Add specified icons to userform
lResult = SetWindowLong(hWnd, GWL_STYLE, lstyle)
If lResult = 0 Then
Debug.Print "SetWindowLong error:"; Err.LastDllError
End If
DrawMenuBar hWnd
Else
MsgBox "AddButtons: userform with caption '" & caption & "' not found"
End If
End SubHere are the subs of the two related modules that create the message boxes
Code:
Sub message()
MsgBox (Cells(Selection.Row, 8).Value)
End Sub
Code:
Sub JEMessage()
MsgBox (Cells(21, Selection.Column).Value)
End Sub
Code:
Option Explicit
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const HWND_TOP = 0
Public Const HWND_BOTTOM = 1
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Public Const GWL_STYLE = -16
Public Const WS_MAXIMIZEBOX = &H10000
Public Const WS_MINIMIZEBOX = &H20000
Public Const WS_SYSMENU = &H80000
#If VBA7 Then
Public Declare PtrSafe Function SetWindowPos Lib "user32" _
(ByVal hWnd As LongPtr, _
ByVal hWndInsertAfter As LongPtr, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal uFlags As Long) As Long
Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As LongPtr
Public Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As LongPtr, _
ByVal nIndex As Long) As Long
Public Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As LongPtr, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Public Declare PtrSafe Function DrawMenuBar Lib "user32" _
(ByVal hWnd As LongPtr) As Long
#Else
Public Declare Function SetWindowPos Lib "user32" _
(ByVal hWnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal uFlags As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Public Declare Function DrawMenuBar Lib "user32" _
(ByVal hWnd As Long) As Long
#End If
Last edited by a moderator:
