VBA code from PC to Mac

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:
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 Sub

Here are the subs of the two related modules that create the message boxes
Code:
Sub message()

MsgBox (Cells(Selection.Row, 8).Value)

End Sub
- AND -

Code:
Sub JEMessage()

MsgBox (Cells(21, Selection.Column).Value)


End Sub
Also here is the rest of the code for the AlwaysTop feature:
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
I would appreciate any help you can give. Thanks.
 
Last edited by a moderator:

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
See all this stuff in your code?

Code:
Public Declare PtrSafe Function SetWindowPos Lib "user32" blah blah blah

These are commands in the Windows API. They won't work on the Mac.

A lot of other things don't work on a Mac. Modeless UserForms, for example, at least last time I checked. Also your UserForms may have looked great on the Windows machine, but on a Mac they're all shriveled up. But you can fix that, as I describe on my blog at Designing UserForms for Mac and Windows.
 
Upvote 0

Forum statistics

Threads
1,224,824
Messages
6,181,187
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top