My Problem is the following:
Userform visualization for understanding
(1)
I have a combobx "CGselectionStrategies" that should be the basis for the Input textboxes below. When the userform is started, I would like it to show the previous input for these boxes, depending on the Combobox selection.
The Input is saved in the worksheet "Commodity Groups" with the following code:
Private Sub SaveCGStrategies_Click()
'Just general stuff
Dim outputBook As Workbook
Set outputBook = ActiveWorkbook
'Note-fields for PU Strategies, incl. Authors
Dim CGselectionStrategies As String
Dim NoteTargetMarket As String
Dim AuthorTargetMarket As String
Dim NotePUMStrategy As String
Dim AuthorPUMStrategy As String
Dim NotePUSStrategy As String
Dim AuthorPUSStrategy As String
Dim NotePULStrategy As String
Dim AuthorPULStrategy As String
CGselectionStrategies = Me.CGselectionStrategies
NoteTargetMarket = Me.NoteTargetMarket
AuthorTargetMarket = Me.NoteAuthorMarketInfo
NotePUMStrategy = Me.NotePUMStrat
AuthorPUMStrategy = Me.NoteAuthorPUMStratInfo
NotePUSStrategy = Me.NotePUSStrat
AuthorPUSStrategy = Me.NoteAuthorPUSStratInfo
NotePULStrategy = Me.NotePULStrat
AuthorPULStrategy = Me.NoteAuthorPULStratInfo
'Save CG Strategies behind them in the List on CG Worksheet
outputBook.Activate
outputBook.Worksheets("Commodity Groups").Select
With Me.CGselectionStrategies
If Me.CGselectionStrategies.value = "Halbzeuge (und Rohstoffe)" Then
Range("K2").Select
ActiveCell.value = NoteTargetMarket
ActiveCell.Offset(0, 1).Select
ActiveCell.value = AuthorTargetMarket
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NotePUMStrat
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NoteAuthorPUMStratInfo
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NotePUSStrat
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NoteAuthorPUSStratInfo
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NotePULStrat
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NoteAuthorPULStratInfo
End If
If Me.CGselectionStrategies.value = "Mechanische Konstruktionsteile" Then
Range("K62").Select
ActiveCell.value = NoteTargetMarket
ActiveCell.Offset(0, 1).Select
ActiveCell.value = AuthorTargetMarket
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NotePUMStrat
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NoteAuthorPUMStratInfo
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NotePUSStrat
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NoteAuthorPUSStratInfo
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NotePULStrat
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NoteAuthorPULStratInfo
End If
If Me.CGselectionStrategies.value = "Norm- und Katalogteile (ausser Elektro)" Then
Range("K87").Select
ActiveCell.value = NoteTargetMarket
ActiveCell.Offset(0, 1).Select
ActiveCell.value = AuthorTargetMarket
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NotePUMStrat
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NoteAuthorPUMStratInfo
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NotePUSStrat
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NoteAuthorPUSStratInfo
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NotePULStrat
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NoteAuthorPULStratInfo
End If
If Me.CGselectionStrategies.value = "Elektrische, elektronische und optische Komponenten und Baugruppen" Then
Range("K127").Select
ActiveCell.value = NoteTargetMarket
ActiveCell.Offset(0, 1).Select
ActiveCell.value = AuthorTargetMarket
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NotePUMStrat
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NoteAuthorPUMStratInfo
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NotePUSStrat
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NoteAuthorPUSStratInfo
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NotePULStrat
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NoteAuthorPULStratInfo
End If
If Me.CGselectionStrategies.value = "Hilfs-, Betriebs- und Produktionshifsmittel" Then
Range("K180").Select
ActiveCell.value = NoteTargetMarket
ActiveCell.Offset(0, 1).Select
ActiveCell.value = AuthorTargetMarket
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NotePUMStrat
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NoteAuthorPUMStratInfo
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NotePUSStrat
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NoteAuthorPUSStratInfo
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NotePULStrat
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NoteAuthorPULStratInfo
End If
If Me.CGselectionStrategies.value = "Subsysteme und Anlagen" Then
Range("K256").Select
ActiveCell.value = NoteTargetMarket
ActiveCell.Offset(0, 1).Select
ActiveCell.value = AuthorTargetMarket
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NotePUMStrat
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NoteAuthorPUMStratInfo
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NotePUSStrat
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NoteAuthorPUSStratInfo
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NotePULStrat
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NoteAuthorPULStratInfo
End If
If Me.CGselectionStrategies.value = "Handelsware" Then
Range("K299").Select
ActiveCell.value = NoteTargetMarket
ActiveCell.Offset(0, 1).Select
ActiveCell.value = AuthorTargetMarket
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NotePUMStrat
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NoteAuthorPUMStratInfo
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NotePUSStrat
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NoteAuthorPUSStratInfo
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NotePULStrat
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NoteAuthorPULStratInfo
End If
If Me.CGselectionStrategies.value = "Dienstleistungen" Then
Range("K310").Select
ActiveCell.value = NoteTargetMarket
ActiveCell.Offset(0, 1).Select
ActiveCell.value = AuthorTargetMarket
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NotePUMStrat
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NoteAuthorPUMStratInfo
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NotePUSStrat
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NoteAuthorPUSStratInfo
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NotePULStrat
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NoteAuthorPULStratInfo
End If
If Me.CGselectionStrategies.value = "Allgemeines und Administration" Then
Range("K360").Select
ActiveCell.value = NoteTargetMarket
ActiveCell.Offset(0, 1).Select
ActiveCell.value = AuthorTargetMarket
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NotePUMStrat
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NoteAuthorPUMStratInfo
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NotePUSStrat
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NoteAuthorPUSStratInfo
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NotePULStrat
ActiveCell.Offset(0, 1).Select
ActiveCell.value = NoteAuthorPULStratInfo
End If
End With
End Sub
My Approach was the following...
'Show old Strategies when selecting a combobox-item
'Start with short Text "Please choose a Commodity Group"
If Me.CGselectionStrategies.value = "" Then
Me.NoteTargetMarket.Text = CStr(ThisWorkbook.Sheets("Commodity Groups").Range("K445").value)
Me.Next Variable
Me.Next Variable
Me.Next Variable
End If
If Me.CGselectionStrategies.value = "Halbzeuge (und Rohstoffe)" Then
Me.NoteTargetMarket.Text = CStr(ThisWorkbook.Sheets("Commodity Groups").Range("K2").value)
Me.Next Variable
Me.Next Variable
Me.Next Variable
End If
...and so on. Needless to say it does not work. I found the following online and tried to adapt it to the best of my abilities, but without success.
'Change Textbot Content based on Combobox selection
Dim wks As Excel.Worksheet
Dim selectedString As Variant
Dim row As Long
Dim value As Variant
Set wks = Worksheets("Commodity Groups")
If CGselectionStrategies.ListIndex <> -1 Then
selectedString = CGselectionStrategies.value
On Error Resume Next
row = Application.WorksheetFunction.Match(selectedString, wks.Columns(1), 0)
On Error GoTo 0
If row Then
value = wks.Cells(row, 2)
DomainOwnerTestBox.value = value
Else
'Value not found in the worksheet 'test'
End If
End If
End Sub
One Problem was also that there are multiple Input values, not only in column 2, which are also separated by many other rows.
I hope my poblem is explained in an understandable manner.
(2)
My second poblem, which is way shorter, is regarding how to avoid having to fill in all textboxes in a userform. The one is question has over 200 Inputs to fill out and whenever I want to test i.e. the positioning of the Input in the database, I get a runtime 13 mistake "Type mismatch." However, if I put an Input in every box, it runs through smoothly. Here a code excerpt how I save my data from the userform Input:
Dim Datum As Date
Dim SName As String
Dim PotentialS As String
Dim SuppNr As Long
Dim Active As String
Datum = Me.TextBox117
SName = Me.SuppName
PotentialS = Me.PotentialS
SuppNr = Me.SuppNo
Active = Me.Active
'Go to the first empty line on the output sheet (Meta DB) in this workbook
outputBook.Activate
outputBook.Worksheets("Meta DB").Range("A3").Select
If outputBook.Worksheets("Meta DB").Range("A3").Offset(1, 0) <> "" Then
outputBook.Worksheets("Meta DB").Range("A3").End(xlDown).Select
End If
'Go to A4 and from there always one below the last filled cell in A
ActiveCell.Offset(1, 0).Select
DatabaseRow = ActiveCell.row
'Post Values for new Entry
'Add a New Supplier Tab - Supplier Profile
ActiveCell.value = Datum
ActiveCell.Offset(0, 1).Select
ActiveCell.value = SName
ActiveCell.Offset(0, 1).Select
ActiveCell.value = PotentialS
ActiveCell.Offset(0, 1).Select
ActiveCell.value = SuppNr
ActiveCell.Offset(0, 1).Select
Any help and tips are welcome.
Firstly I think shortening the SaveCGStrategies_Click code will help understand VBA a little better, what you have done is one by one check every option to save the values, but consider the first option was selected, then you would never need to check the others as you would have found your match, the code is also duplicated each time, the below checks selection and runs a single instance of the code once but against the relevant cells.
Private Sub SaveCGStrategies_Click()
Dim LngRow As Long
Dim outputBook As Workbook
Dim outputSheet As Worksheet
Set outputBook = ActiveWorkbook
Set outputSheet = outputBook.Worksheets("Commodity Groups")
'With Me.CGselectionStrategies
Select Case Me.CGselectionStrategies.Value
Case "Halbzeuge (und Rohstoffe)"
LngRow = 2
Case "Mechanische Konstruktionsteile"
LngRow = 62
Case "Norm- und Katalogteile (ausser Elektro)"
LngRow = 87
Case "Elektrische, elektronische und optische Komponenten und Baugruppen"
LngRow = 127
Case "Hilfs-, Betriebs- und Produktionshifsmittel"
LngRow = 180
Case "Subsysteme und Anlagen"
LngRow = 256
Case "Handelsware"
LngRow = 299
Case "Dienstleistungen"
LngRow = 310
Case "Allgemeines und Administration"
LngRow = 360
End Select
outputSheet.Cells(LngRow, 11) = Me.NoteTargetMarket
outputSheet.Cells(LngRow, 13) = Me.NoteAuthorMarketInfo
outputSheet.Cells(LngRow, 14) = Me.NotePUMStrat
outputSheet.Cells(LngRow, 15) = Me.NoteAuthorPUMStratInfo
outputSheet.Cells(LngRow, 16) = Me.NotePUSStrat
outputSheet.Cells(LngRow, 17) = Me.NoteAuthorPUSStratInfo
outputSheet.Cells(LngRow, 18) = Me.NotePULStrat
outputSheet.Cells(LngRow, 19) = Me.NoteAuthorPULStratInfo
Set outputSheet = Nothing
Set outputBook = Nothing
End Sub
In the same way you referenced the workbook, it also references the worksheet to enable us to write into the ranges of the worksheet that we want to with less code. I have not used the .Select and Activate functions that you had as these can have performance issues. I have also referenced the values directly and not placed them in a variable first, if you were planning to manipulate them prior to writing them to a cell then a variable may be of use but if it is a straight insert from textbox to cell, we can pass it straight through.
Your second issue needs more input to be certain but I suspect relates data types.
Dim Datum As Date
Datum = Me.TextBox117
Is Me.TextBox117 a date in a valid date format? this could be checked as below: -
If IsDate(Me.TextBox117) then Datum = CDate(Me.TextBox117)
The functionCDate ensure the value is passed into the variable as a date.
Dim SuppNr As Long
SuppNr = Me.SuppNo
Is Me.SuppNo a valid number? this could be checked as below: -
If IsNumeric(Me.SuppNo) then SuppNr = CLng(Me.SuppNo)
My recommendation would be while getting it work you set them all to String or pass them through as is.
Hi one thing is for certain - you need to get rid of all of these .Select's
They make it incredibly hard to read. I myself have only just started learning VBA too (about 3 weeks ago). Please look at the following link - How to avoid using Select in Excel VBA macros . It should help you with your VBA readability. It will also make your code about a gazillion times faster.
This will also help you from having to use ActiveCell every other command.
Another tip is instead of you having
Dim *StringVariable* as string
as a line of code that you start off with at the beginning -
if you want to name a cell something, just give its range and then make it = to "String" e.g.
Range("A1") = "This is a String"
I am not experienced enough with VBA to know what is the matter with your TextBox, but i hope this is a good start to aid your general VBA writing.
What´s the best way to log each action executed in VBA? Is there some built-in Windows object that already does this that I can use?
(I'm not referring to user actions)
Thanks
This will log actions typed into cells. Right-click your sheet and paste the code into the window that opens..
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("$A$1:$b$400")) Is Nothing Then
Application.EnableEvents = False
Application.ScreenUpdating = False
With Worksheets("Sheet2")
.Select
.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Select
ActiveCell.Value = Target.Address
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Target.Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Now()
ActiveCell.NumberFormat = "mm/dd/yy"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = InputBox("You've made a change to the Rates tab. Please enter your name here for historical purposes.")
Application.EnableEvents = True
Application.ScreenUpdating = True
End With
End If
End Sub
I have this code where a msgbox pops up notifying a duplicate value.
Problem is the msgbox() does not go away on clicking ok and the code gets stuck.
Dim row As Integer
Dim counter As Integer
Range("c2").Activate
Application.ScreenUpdating = False
For counter = 0 To 688
If ActiveCell.Value = ActiveCell.Offset(1, 0).Value And ActiveCell.Offset(0, 2).Value = ActiveCell.Offset(1, 2).Value And ActiveCell.Offset(0, 3).Value = ActiveCell.Offset(1, 3).Value And ActiveCell.Offset(0, 9).Value = ActiveCell.Offset(1, 9).Value Then
MsgBox ("Found a duplicate")
Else ActiveCell.Offset(1, 0).Activate
End If
Next counter
The problem is that when the If is True the MsgBox is displayed and ActiveCell is never incremented. Therefore the MsgBox gets re-displayed 687 times!
I have to put jobs from one spreadsheet onto another in their priority order. If a job is listed as completed, then I do not transfer that job over. Below is my code for the top priority, "priority 1". The cell that states it's completion status sometimes has a date before or after it, which is why I put the "*" character.
Do Until IsEmpty(ActiveCell) Or count > 14
If ActiveCell.Value = "Priority I" Then
ActiveCell.Offset(0, 6).Select
If ActiveCell.value = "completed" like "*completed*" Then
ActiveCell.Offset(1, -6).Select
Else
ActiveCell.Offset(0, -1).Select
word0 = ActiveCell.Value
ActiveWindow.ActivateNext
ActiveCell = word0
ActiveWindow.ActivateNext
ActiveCell.Offset(0, -9).Select
word = Left(ActiveCell.Value, 6)
ThisWorkbook.Activate
ActiveCell.Offset(0, 1).Select
ActiveCell = word
ActiveWindow.ActivateNext
ActiveCell.Offset(0, 1).Select
word1 = ActiveCell.Value
ThisWorkbook.Activate
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = word1
ActiveWindow.ActivateNext
ActiveCell.Offset(0, 1).Select
word2 = ActiveCell.Value
ThisWorkbook.Activate
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = word2
ActiveWindow.ActivateNext
ActiveCell.Offset(0, 1).Select
word3 = ActiveCell.Value
ThisWorkbook.Activate
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = word3
ActiveCell.Offset(1, -4).Select
ActiveWindow.ActivateNext
ActiveCell.Offset(1, 1).Select
count = count + 1
End If
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
I have confirmed that it is checking the correct column, it just doesn't catch the word completed. So the problem resides within that line, line 4.
Change
If ActiveCell.value = "completed" like "*completed*" Then
to
If Instr(1, UCase(ActiveCell.Value), "COMPLETED") > 0 Then
or
If UCase(ActiveCell.Value) like "*COMPLETED*" Then
I have a problem with looping a Macro in excel.
I have a Data base where i need to add a row above each unique value and copy the value below into the new row.
untill now i have come up with this:
Sub Test()
'
' Sneltoets: Ctrl+K
' FindNextValueChangeInColumn Macro
'
Dim currentValue As String
Dim compareValue As String
currentValue = ActiveCell.Value
If (currentValue = "") Then
Selection.End(xlDown).Select
Else
ActiveCell.Offset(1, 0).Select
compareValue = ActiveCell.Value
Do While currentValue = compareValue
ActiveCell.Offset(1, 0).Select
compareValue = ActiveCell.Value
Loop
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Offset(1, 0).Select
Selection.Copy
ActiveCell.Offset(-1, 0).Select
Selection.PasteSpecial
End If
Exit Sub
End Sub
This macro does the job, but i dont want to press ctrl-k 4000 times every time an update is necessary. Anyone knows how to loop this macro ?
Just wrap a for loop around the code you want executed:
Sub Test()
'
' Sneltoets: Ctrl+K
' FindNextValueChangeInColumn Macro
'
'-------Loop from 1 to 4000------------
Dim loopy
For loopy = 1 to 4000 'Loop 4000 times
'--------------------------------------
Dim currentValue As String
Dim compareValue As String
currentValue = ActiveCell.Value
If (currentValue = "") Then
Selection.End(xlDown).Select
Else
ActiveCell.Offset(1, 0).Select
compareValue = ActiveCell.Value
Do While currentValue = compareValue
ActiveCell.Offset(1, 0).Select
compareValue = ActiveCell.Value
Loop
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Offset(1, 0).Select
Selection.Copy
ActiveCell.Offset(-1, 0).Select
Selection.PasteSpecial
End If
'-----Don't forget this line-----
Next loopy
'--------------------------------
Exit Sub
End Sub
Alternatively, you can use a while loop to loop until the currentValue = "":
Do
currentValue = ActiveCell.Value
If (currentValue = "") Then
Selection.End(xlDown).Select
Else
ActiveCell.Offset(1, 0).Select
compareValue = ActiveCell.Value
Do While currentValue = compareValue
ActiveCell.Offset(1, 0).Select
compareValue = ActiveCell.Value
Loop
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Offset(1, 0).Select
Selection.Copy
ActiveCell.Offset(-1, 0).Select
Selection.PasteSpecial
End If
Loop While currentValue <> ""