Novice vba excel windows. trying to get a userform to work on both platforms.
I was able to get this to work on windows but it wont run on MAC. Please excuse the sloppy coding, im a novice.
From my understanding MAC does not have "rowsource" so those areas need to be reworked. here is the code for the Module......
Option Explicit Public iWidth As Integer Public iHeight As Integer Public iLeft As Integer Public iTop As Integer Public bState As Boolean
Sub Reset()
Dim iRow As Long iRow = [Counta(Database!A:A)] ' idetifying the last row With frmForm .txtID.Value = "" .optCalifornia.Value = False .optFlorida.Value = False .txtEstimate.Value = "" .bqTextBox1.Value = "" .bqTextBox2.Value = "" .bqTextBox3.Value = "" .bqTextBox4.Value = "" .bqTextBox5.Value = "" .bqTextBox6.Value = "" .bqTextBox7.Value = "" .bqTextBox8.Value = "" .bqTextBox9.Value = "" .bqTextBox10.Value = "" .idminus.Value = "" 'Default Color .txtID.BackColor = vbWhite .cmbBidder.BackColor = vbWhite .txtEstimate.BackColor = vbWhite .bqComboBox1.BackColor = vbWhite .bqComboBox2.BackColor = vbWhite .bqComboBox3.BackColor = vbWhite .bqTextBox1.BackColor = vbWhite .bqTextBox2.BackColor = vbWhite .bqTextBox3.BackColor = vbWhite .bqTextBox4.BackColor = vbWhite .bqTextBox5.BackColor = vbWhite .bqTextBox6.BackColor = vbWhite .bqTextBox7.BackColor = vbWhite .bqTextBox8.BackColor = vbWhite .bqTextBox9.BackColor = vbWhite .bqTextBox10.BackColor = vbWhite .idminus.BackColor = RGB(245, 245, 245) '-------------------------------- '-------added 4/26 to ----creates error , so removed------------------------ '.cmdbidder.Clear '.bqComboBox1.Clear '.bqComboBox2.Clear '.bqComboBox3.Clear 'Creating a dynamic name for bidder (a2), Version (c2),Bidtype (e2), BidStatus(g2) 'added to skip over error 4/27 On Error Resume Next shSupport.Range("A2", shSupport.Range("A" & Application.Rows.Count).End(xlUp)).Name = "Dynamic1" .cmbBidder.RowSource = "Dynamic1" .cmbBidder.Value = "" shSupport.Range("C2", shSupport.Range("C" & Application.Rows.Count).End(xlUp)).Name = "Dynamic2" .bqComboBox1.RowSource = "Dynamic2" .bqComboBox1.Value = "" shSupport.Range("E2", shSupport.Range("E" & Application.Rows.Count).End(xlUp)).Name = "Dynamic3" .bqComboBox2.RowSource = "Dynamic3" .bqComboBox2.Value = "" shSupport.Range("G2", shSupport.Range("G" & Application.Rows.Count).End(xlUp)).Name = "Dynamic4" .bqComboBox3.RowSource = "Dynamic4" .bqComboBox3.Value = "" '**** bq turn off 4/27----------------------------------------------------- '.txtRowNumber.Value = "" 'Below code are associated with Search Feature - Part 3 Call Add_SearchColumn ThisWorkbook.Sheets("Database").AutoFilterMode = False ThisWorkbook.Sheets("SearchData").AutoFilterMode = False ThisWorkbook.Sheets("SearchData").Cells.Clear '----------------------------------------------- .lstDatabase.ColumnCount = 20 .lstDatabase.ColumnHeads = True .lstDatabase.ColumnWidths = "20,40,30,70,170,20,60,60,70,80,80,80,75,70,60,70,70,60,80,80" If iRow > 1 Then .lstDatabase.RowSource = "Database!A2:T" & iRow Else .lstDatabase.RowSource = "Database!A2:T2" End If End With End Sub
Sub Submit()
Dim sh As Worksheet Dim iRow As Long Set sh = ThisWorkbook.Sheets("Database") If frmForm.txtRowNumber.Value = "" Then iRow = [Counta(Database!A:A)] + 1 Else iRow = frmForm.txtRowNumber.Value End If With sh .Cells(iRow, 1) = "=Row()-1" 'Dynamic Serial Number .Cells(iRow, 2) = frmForm.txtID.Value .Cells(iRow, 3) = IIf(frmForm.optFlorida.Value = True, "FL", "CA") .Cells(iRow, 4) = frmForm.cmbBidder.Value .Cells(iRow, 5) = frmForm.txtEstimate.Value .Cells(iRow, 6) = frmForm.bqComboBox1.Value .Cells(iRow, 7) = frmForm.bqComboBox2.Value .Cells(iRow, 8) = frmForm.bqComboBox3.Value .Cells(iRow, 9) = frmForm.bqTextBox1.Value .Cells(iRow, 10) = frmForm.bqTextBox2.Value .Cells(iRow, 11) = frmForm.bqTextBox3.Value .Cells(iRow, 12) = frmForm.bqTextBox4.Value .Cells(iRow, 13) = frmForm.bqTextBox5.Value .Cells(iRow, 14) = frmForm.bqTextBox6.Value .Cells(iRow, 15) = frmForm.bqTextBox7.Value .Cells(iRow, 16) = frmForm.bqTextBox8.Value .Cells(iRow, 17) = frmForm.bqTextBox9.Value .Cells(iRow, 18) = frmForm.bqTextBox10.Value .Cells(iRow, 19) = Application.UserName .Cells(iRow, 20) = [Text(Now(), "DD-MM-YYYY HH:MM:SS")] End With End Sub
Sub Show_Form()
'' Change to ----frmForm.show false---- to allow user to go to different sheets frmForm.Show False End Sub
Function Selected_List() As Long
Dim i As Long Selected_List = 0 For i = 0 To frmForm.lstDatabase.ListCount - 1 If frmForm.lstDatabase.Selected(i) = True Then Selected_List = i + 1 Exit For End If Next i End Function
Sub Add_SearchColumn()
frmForm.EnableEvents = False With frmForm.cmbSearchColumn .Clear .AddItem "All" .AddItem "ID" .AddItem "BID REF" .AddItem "CA/FL" .AddItem "BIDDER" .AddItem "ESTIMATE" .AddItem "BID TYPE" .AddItem "BID STATUS" .AddItem "COMPANY" .AddItem "CONTACT NAME" .AddItem "JOB WALK DATE" .AddItem "RFI DATE" .AddItem "BID DUE DATE" .AddItem "BID AWARD DATE" .Value = "All" End With frmForm.EnableEvents = True frmForm.txtSearch.Value = "" frmForm.txtSearch.Enabled = False frmForm.cmdSearch.Enabled = False End Sub
Sub SearchData()
Application.ScreenUpdating = False Dim shDatabase As Worksheet ' Database sheet Dim shSearchData As Worksheet 'SearchData sheet Dim iColumn As Integer 'To hold the selected column number in Database sheet Dim iDatabaseRow As Long 'To store the last non-blank row number available in Database sheet Dim iSearchRow As Long 'To hold the last non-blank row number available in SearachData sheet Dim sColumn As String 'To store the column selection Dim sValue As String 'To hold the search text value Set shDatabase = ThisWorkbook.Sheets("Database") Set shSearchData = ThisWorkbook.Sheets("SearchData") iDatabaseRow = ThisWorkbook.Sheets("Database").Range("A" & Application.Rows.Count).End(xlUp).Row sColumn = frmForm.cmbSearchColumn.Value sValue = frmForm.txtSearch.Value iColumn = Application.WorksheetFunction.Match(sColumn, shDatabase.Range("A1:T1"), 0) 'Remove filter from Database worksheet If shDatabase.FilterMode = True Then shDatabase.AutoFilterMode = False End If 'Apply filter on Database worksheet If frmForm.cmbSearchColumn.Value = "ID" Then shDatabase.Range("A1:T" & iDatabaseRow).AutoFilter Field:=iColumn, Criteria1:=sValue Else shDatabase.Range("A1:T" & iDatabaseRow).AutoFilter Field:=iColumn, Criteria1:="*" & sValue & "*" End If If Application.WorksheetFunction.Subtotal(3, shDatabase.Range("A:A")) >= 2 Then 'Code to remove the previous data from SearchData worksheet shSearchData.Cells.Clear shDatabase.AutoFilter.Range.Copy shSearchData.Range("A1") Application.CutCopyMode = False iSearchRow = shSearchData.Range("A" & Application.Rows.Count).End(xlUp).Row frmForm.lstDatabase.ColumnCount = 20 frmForm.lstDatabase.ColumnWidths = "20,40,30,70,170,20,60,60,70,80,80,80,75,70,60,70,70,60,80,80" If iSearchRow > 1 Then frmForm.lstDatabase.RowSource = "SearchData!A2:T" & iSearchRow MsgBox "Records found." End If Else 'bq add clear database------------------------------------------------------------------------------------------------------------ frmForm.lstDatabase.RowSource = "" '------------------------------------------------------- MsgBox "No record found." End If shDatabase.AutoFilterMode = False Application.ScreenUpdating = True End Sub
Function ValidateEntries() As Boolean
ValidateEntries = True Dim iID As Variant Dim sh As Worksheet Set sh = ThisWorkbook.Sheets("Print") iID = frmForm.txtID.Value With frmForm 'Default Color .txtID.BackColor = vbWhite .cmbBidder.BackColor = vbWhite .txtEstimate.BackColor = vbWhite .bqComboBox1.BackColor = vbWhite .bqComboBox2.BackColor = vbWhite .bqComboBox3.BackColor = vbWhite .bqTextBox1.BackColor = vbWhite .bqTextBox2.BackColor = vbWhite .bqTextBox3.BackColor = vbWhite .bqTextBox4.BackColor = vbWhite .bqTextBox5.BackColor = vbWhite .bqTextBox6.BackColor = vbWhite .bqTextBox7.BackColor = vbWhite .bqTextBox8.BackColor = vbWhite .bqTextBox9.BackColor = vbWhite .bqTextBox10.BackColor = vbWhite .idminus.BackColor = RGB(245, 245, 245) '-------------------------------- If Trim(.txtID.Value) = "" Then MsgBox "Please enter Estimate ID.", vbOKOnly + vbInformation, "Est. ID" ValidateEntries = False .txtID.BackColor = vbYellow .txtID.SetFocus Exit Function End If 'Validating Duplicate Entries If Not sh.Range("B:B").Find(what:=iID, lookat:=xlWhole) Is Nothing Then MsgBox "Duplicate Estimate ID found.", vbOKOnly + vbInformation, "Est. ID" ValidateEntries = False .txtID.BackColor = vbYellow .txtID.SetFocus Exit Function End If If Trim(.txtEstimate.Value) = "" Then MsgBox "Please enter Estimate Name.", vbOKOnly + vbInformation, "Est. Name" ValidateEntries = False .txtEstimate.BackColor = vbYellow .txtEstimate.SetFocus Exit Function End If 'Validating AES Location If .optFlorida.Value = False And .optCalifornia.Value = False Then MsgBox "Please select AES Location.", vbOKOnly + vbInformation, "Location" ValidateEntries = False Exit Function End If If Trim(.cmbBidder.Value) = "" Then MsgBox "Please select bidder name from drop-down.", vbOKOnly + vbInformation, "Bidder" ValidateEntries = False .cmbBidder.BackColor = vbYellow .cmbBidder.SetFocus Exit Function End If If Trim(.txtEstimate.Value) = "" Then MsgBox "Please enter Estimate Name.", vbOKOnly + vbInformation, "Estimate Name" ValidateEntries = False .txtEstimate.BackColor = vbYellow .txtEstimate.SetFocus Exit Function End If If Trim(.bqComboBox1.Value) = "" Then MsgBox "Please select Version from drop-down.", vbOKOnly + vbInformation, "Version" ValidateEntries = False .bqComboBox1.BackColor = vbYellow .bqComboBox1.SetFocus Exit Function End If If Trim(.bqComboBox2.Value) = "" Then MsgBox "Please select Bid Type from drop-down.", vbOKOnly + vbInformation, "Bid Type" ValidateEntries = False .bqComboBox2.BackColor = vbYellow .bqComboBox2.SetFocus Exit Function End If If Trim(.bqComboBox3.Value) = "" Then MsgBox "Please select Bid Status from drop-down.", vbOKOnly + vbInformation, "Bid Status" ValidateEntries = False .bqComboBox3.BackColor = vbYellow .bqComboBox3.SetFocus Exit Function End If If Trim(.bqTextBox1.Value) = "" Then MsgBox "Please enter Bid Value.", vbOKOnly + vbInformation, "Bid Value" ValidateEntries = False .bqTextBox1.BackColor = vbYellow .bqTextBox1.SetFocus Exit Function End If If Trim(.bqTextBox2.Value) = "" Then MsgBox "Please enter Company Name.", vbOKOnly + vbInformation, "Company Name" ValidateEntries = False .bqTextBox2.BackColor = vbYellow .bqTextBox2.SetFocus Exit Function End If If Trim(.bqTextBox3.Value) = "" Then MsgBox "Please enter Contact Name.", vbOKOnly + vbInformation, "Contact Name" ValidateEntries = False .bqTextBox3.BackColor = vbYellow .bqTextBox3.SetFocus Exit Function End If If Trim(.bqTextBox4.Value) = "" Then MsgBox "Please enter Contact Email.", vbOKOnly + vbInformation, "Contact Email" ValidateEntries = False .bqTextBox4.BackColor = vbYellow .bqTextBox4.SetFocus Exit Function End If If Trim(.bqTextBox5.Value) = "" Then MsgBox "Please enter Contact Phone.", vbOKOnly + vbInformation, "Contact Phone" ValidateEntries = False .bqTextBox5.BackColor = vbYellow .bqTextBox5.SetFocus Exit Function End If If Trim(.bqTextBox6.Value) = "" Then MsgBox "Please enter Job Walk Date.", vbOKOnly + vbInformation, "Job Walk Date" ValidateEntries = False .bqTextBox6.BackColor = vbYellow .bqTextBox6.SetFocus Exit Function End If If Trim(.bqTextBox7.Value) = "" Then MsgBox "Please enter RFI Date.", vbOKOnly + vbInformation, "RFI Date" ValidateEntries = False .bqTextBox7.BackColor = vbYellow .bqTextBox7.SetFocus Exit Function End If If Trim(.bqTextBox8.Value) = "" Then MsgBox "Please enter Bid Due Date.", vbOKOnly + vbInformation, "Bid Due Date" ValidateEntries = False .bqTextBox8.BackColor = vbYellow .bqTextBox8.SetFocus Exit Function End If If Trim(.bqTextBox9.Value) = "" Then MsgBox "Please enter Bid Award Date.", vbOKOnly + vbInformation, "Bid Award Date" ValidateEntries = False .bqTextBox9.BackColor = vbYellow .bqTextBox9.SetFocus Exit Function End If '''''BQ NOTE ----no validate on note field''''' End With End Function
Function ValidatePrintDetails() As Boolean
ValidatePrintDetails = True Dim iID As Variant Dim sh As Worksheet Set sh = ThisWorkbook.Sheets("Print") iID = frmForm.txtID.Value With frmForm 'Default Color .txtID.BackColor = vbWhite .cmbBidder.BackColor = vbWhite .txtEstimate.BackColor = vbWhite .bqComboBox1.BackColor = vbWhite .bqComboBox2.BackColor = vbWhite .bqComboBox3.BackColor = vbWhite .bqTextBox1.BackColor = vbWhite .bqTextBox2.BackColor = vbWhite .bqTextBox3.BackColor = vbWhite .bqTextBox4.BackColor = vbWhite .bqTextBox5.BackColor = vbWhite .bqTextBox6.BackColor = vbWhite .bqTextBox7.BackColor = vbWhite .bqTextBox8.BackColor = vbWhite .bqTextBox9.BackColor = vbWhite .bqTextBox10.BackColor = vbWhite .idminus.BackColor = RGB(245, 245, 245) '-------------------------------- If Trim(.txtID.Value) = "" Then MsgBox "Please enter Estimate ID.", vbOKOnly + vbInformation, "Est. ID" ValidatePrintDetails = False .txtID.BackColor = vbYellow .txtID.SetFocus Exit Function End If 'Validating Duplicate Entries If Not sh.Range("B:B").Find(what:=iID, lookat:=xlWhole) Is Nothing Then MsgBox "Duplicate Estimate ID found.", vbOKOnly + vbInformation, "Est. ID" ValidatePrintDetails = False .txtID.BackColor = vbYellow .txtID.SetFocus Exit Function End If If Trim(.txtEstimate.Value) = "" Then MsgBox "Please enter Estimate Name.", vbOKOnly + vbInformation, "Est. Name" ValidatePrintDetails = False .txtEstimate.BackColor = vbYellow .txtEstimate.SetFocus Exit Function End If 'Validating AES Location If .optFlorida.Value = False And .optCalifornia.Value = False Then MsgBox "Please select AES Location.", vbOKOnly + vbInformation, "Location" ValidatePrintDetails = False Exit Function End If If Trim(.cmbBidder.Value) = "" Then MsgBox "Please select bidder name from drop-down.", vbOKOnly + vbInformation, "Bidder" ValidatePrintDetails = False .cmbBidder.BackColor = vbYellow .cmbBidder.SetFocus Exit Function End If If Trim(.txtEstimate.Value) = "" Then MsgBox "Please enter Estimate Name.", vbOKOnly + vbInformation, "Estimate Name" ValidatePrintDetails = False .txtEstimate.BackColor = vbYellow .txtEstimate.SetFocus Exit Function End If If Trim(.bqComboBox1.Value) = "" Then MsgBox "Please select Version from drop-down.", vbOKOnly + vbInformation, "Version" ValidatePrintDetails = False .bqComboBox1.BackColor = vbYellow .bqComboBox1.SetFocus Exit Function End If If Trim(.bqComboBox2.Value) = "" Then MsgBox "Please select Bid Type from drop-down.", vbOKOnly + vbInformation, "Bid Type" ValidatePrintDetails = False .bqComboBox2.BackColor = vbYellow .bqComboBox2.SetFocus Exit Function End If If Trim(.bqComboBox3.Value) = "" Then MsgBox "Please select Bid Status from drop-down.", vbOKOnly + vbInformation, "Bid Status" ValidatePrintDetails = False .bqComboBox3.BackColor = vbYellow .bqComboBox3.SetFocus Exit Function End If If Trim(.bqTextBox1.Value) = "" Then MsgBox "Please enter Bid Value.", vbOKOnly + vbInformation, "Bid Value" ValidatePrintDetails = False .bqTextBox1.BackColor = vbYellow .bqTextBox1.SetFocus Exit Function End If If Trim(.bqTextBox2.Value) = "" Then MsgBox "Please enter Company Name.", vbOKOnly + vbInformation, "Company Name" ValidatePrintDetails = False .bqTextBox2.BackColor = vbYellow .bqTextBox2.SetFocus Exit Function End If If Trim(.bqTextBox3.Value) = "" Then MsgBox "Please enter Contact Name.", vbOKOnly + vbInformation, "Contact Name" ValidatePrintDetails = False .bqTextBox3.BackColor = vbYellow .bqTextBox3.SetFocus Exit Function End If If Trim(.bqTextBox4.Value) = "" Then MsgBox "Please enter Contact Email.", vbOKOnly + vbInformation, "Contact Email" ValidatePrintDetails = False .bqTextBox4.BackColor = vbYellow .bqTextBox4.SetFocus Exit Function End If If Trim(.bqTextBox5.Value) = "" Then MsgBox "Please enter Contact Phone.", vbOKOnly + vbInformation, "Contact Phone" ValidatePrintDetails = False .bqTextBox5.BackColor = vbYellow .bqTextBox5.SetFocus Exit Function End If If Trim(.bqTextBox6.Value) = "" Then MsgBox "Please enter Job Walk Date.", vbOKOnly + vbInformation, "Job Walk Date" ValidatePrintDetails = False .bqTextBox6.BackColor = vbYellow .bqTextBox6.SetFocus Exit Function End If If Trim(.bqTextBox7.Value) = "" Then MsgBox "Please enter RFI Date.", vbOKOnly + vbInformation, "RFI Date" ValidatePrintDetails = False .bqTextBox7.BackColor = vbYellow .bqTextBox7.SetFocus Exit Function End If If Trim(.bqTextBox8.Value) = "" Then MsgBox "Please enter Bid Due Date.", vbOKOnly + vbInformation, "Bid Due Date" ValidatePrintDetails = False .bqTextBox8.BackColor = vbYellow .bqTextBox8.SetFocus Exit Function End If If Trim(.bqTextBox9.Value) = "" Then MsgBox "Please enter Bid Award Date.", vbOKOnly + vbInformation, "Bid Award Date" ValidatePrintDetails = False .bqTextBox9.BackColor = vbYellow .bqTextBox9.SetFocus Exit Function End If '''''BQ NOTE 2 ---- copy and pasted from validate Entries above..''''' End With End Function
Sub Print_Form()
Application.ScreenUpdating = False Application.DisplayAlerts = False Dim sh As Worksheet Set sh = ThisWorkbook.Sheets("Print") With frmForm sh.Range("E3").Value = .txtID.Value sh.Range("E4").Value = IIf(.optFlorida.Value = True, "FL", "CA") sh.Range("E5").Value = .cmbBidder.Value sh.Range("E6").Value = .txtEstimate.Value sh.Range("E7").Value = .bqComboBox1.Value sh.Range("E8").Value = .bqComboBox2.Value sh.Range("E9").Value = .bqComboBox3.Value sh.Range("E10").Value = .bqTextBox1.Value sh.Range("E11").Value = .bqTextBox2.Value sh.Range("E12").Value = .bqTextBox3.Value sh.Range("E13").Value = .bqTextBox4.Value sh.Range("E14").Value = .bqTextBox5.Value sh.Range("E15").Value = .bqTextBox6.Value sh.Range("E16").Value = .bqTextBox7.Value sh.Range("E17").Value = .bqTextBox8.Value sh.Range("E18").Value = .bqTextBox9.Value sh.Range("E19").Value = .bqTextBox10.Value End With 'Code to Print the form or Export to PDF sh.PageSetup.PrintArea = "$B$1:$I$19" 'sh.PrintOut copies:=1, IgnorePrintAreas:=False 'temp error correct turned off 4/26------------------------------------------------------------------------------------------ 'On Error Resume Next sh.ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & Application.PathSeparator & frmForm.txtEstimate.Value & ".pdf" MsgBox "Estimate details have been printed.", vbOKOnly + vbInformation, "Print"
Application.ScreenUpdating = True Application.DisplayAlerts = True
End Sub
Sub Maximize_Restore()
If Not bState = True Then iWidth = frmForm.Width iHeight = frmForm.Height iTop = frmForm.Top iLeft = frmForm.Left 'Code for full screen With Application .WindowState = xlMaximized frmForm.Zoom = Int(.Width / frmForm.Width * 100) frmForm.StartUpPosition = 0 frmForm.Left = .Left frmForm.Top = .Top frmForm.Width = .Width frmForm.Height = .Height End With frmForm.cmdFullScreen.Caption = "Restore" bState = True Else With Application .WindowState = xlNormal frmForm.Zoom = 100 frmForm.StartUpPosition = 0 frmForm.Left = iLeft frmForm.Width = iWidth frmForm.Height = iHeight frmForm.Top = iTop End With frmForm.cmdFullScreen.Caption = "Full Screen" bState = False End If End Sub
https://stackoverflow.com/questions/67327104/windows-vs-mac-excel-rowsource-listbox-combobox April 30, 2021 at 09:34AM
没有评论:
发表评论