I hope your weeks are going well.
Currently writing a data entry from in a VBA user form,
It will be using an array of checkboxes to select size which then fills a row with the other data provided when that checkbox is ticked.
I'm currently running into an issue where I don't know what code to run to have the function delete its previous data when the checkbox is unticked.
Private Sub CheckBox0k_Click()
'''Input
Dim ws As Worksheet
Dim LastRow As Long, RowInsert As Long
Set ws = ThisWorkbook.Worksheets("stock")
With ws
LastRow = .Cells(Rows.Count, "A").End(xlUp).row
RowInsert = .Range("A1:A" & LastRow).Find("*", .Cells(LastRow, "A"), xlValues, , , xlPrevious).row
RowInsert = RowInsert + 1
'add the uk size input code here
'''Checkbox based search
''Start
If Me.CheckBox0k.Value = True Then
''''This has to match the number of rows input below
.Cells(RowInsert, "A").Resize(1, 8).Value = Array( _
Me.txtDate.Text, _
Me.textboxparentsku.Text, _
Me.textboxsku.Text, _
Me.comboboxbrand.Text, _
Me.comboboxclosure.Text, _
Me.comboboxgender.Text, _
Me.comboboxmaterial.Text, _
Me.comboboxmodel.Text _
)
ws.Range("I" & RowInsert).Value = CheckBox0k.Caption
'This is the code I'm having issues with
ElseIf CheckBox0k.Value = False Then
.Cells(RowInsert, "A").Resize(1, 8).Value = ws.Range("I" & RowInsert).Value = ""
End If
''Finish
Set ws = Nothing
End With
End Sub
A picture of the current UI with the multiple checkboxes
In order to help, we would need to know more about the process. I men, do you need clearing the last 8 entries (columns)? If so, the working solution should be something like
.Cells(RowInsert, "A").Resize(1, - 9).Value = ""
But your code must check if there are data in the first columns of the row to be processed and warn...
Ok I have sorted it I made a new rule called RowInvert = RowInsert - 1 and put that into FaneDuru's code:
ElseIf Me.CheckBox0k.Value = False Then .Cells(RowInvert, "A").Resize(1, 9).Value = ""
Related
This is my first time using VBA and macros in excel, or excel really for that matter. I appreciate any help or insight that you could give me, ranging from what functions to loops can help me succeed in this task
I am trying to get this workbook set up from this:
Sample Work Book
I get a list that has to be reordered in order to import into another system. My task list is as follows for a macro:
Names and companies have to be merged into one, if there is a different name of a person, that must be concatenated. There will not be two different companies per company header.
Every File ID per company must be concatenated
Individual fees must be replaced with total fee per company.
Sorted by internal ID #, A-Z
Only one header on the new sheet
To look like this:
Target Work Book
My code below runs this: Current Progress
Sub format()
Application.ScreenUpdating = False
'This is the setup to get rid of unnecessary cells'
Dim rCell As Range
Dim cRow As Long, LastRow As Long
LastRow = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
'''Delete Merged Cells'''
With Worksheets("Sheet1").Range("A1", Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp))
Do
Set c = .Find(What:="*Company Name:*", After:=[A1], LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not c Is Nothing Then
cRow = c.Row
c.EntireRow.Delete
End If
Loop While Not c Is Nothing And cRow < LastRow
End With
'''Delete Headings'''
With Worksheets("Sheet1").Range("A1", Worksheets("Sheet1").Range("B" & Rows.Count).End(xlUp))
Do
Set c = .Find(What:="*File #*", After:=[A1], LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not c Is Nothing Then
cRow = c.Row
c.EntireRow.Delete
End If
Loop While Not c Is Nothing And cRow < LastRow
End With
''' Delete Sub Total"""
With Worksheets("Sheet1").Range("A1", Worksheets("Sheet1").Range("B" & Rows.Count).End(xlUp))
Do
Set c = .Find(What:="*Sub Total:*", After:=[A1], LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not c Is Nothing Then
cRow = c.Row
c.EntireRow.Delete
End If
Loop While Not c Is Nothing And cRow < LastRow
End With
End Sub
Again, I appreciate any help on this matter. Thank you!
There are a lot of ways to loop through the cells.
I picked column D with the company name as it didn't have too much clutter.
It's usually good to find the last row, to not loop through cells that we don't need. THere is a lot of ways for doing so as well. Today we'll go with Range("D" & .Rows.Count).End(xlUp).Row.
For the loop, we can use the For next approach, example:
For i = 1 To Sheets(1).Range("A" & Sheets(1).Rows.Count).End(xlUp).Row
If Not Cells(i, 4).Value = "" Then
Next i
But this time, I went with the For Each, because I think it's a bit more readable.
Sub groupingEach()
Dim entry As Variant, prev As String, lRow As Long, lRow2 As Long
Dim inSht As Worksheet, outSht As Worksheet
Set inSht = Sheets(1)
Set outSht = Sheets(2)
lRow = inSht.Range("D" & inSht.Rows.Count).End(xlUp).Row 'last row
For Each entry In inSht.Range("D1:D" & lRow) 'loop 1st sheet
lRow2 = outSht.Range("D" & outSht.Rows.Count).End(xlUp).Row 'last row in output
If entry = prev And Not entry = "" Then
'-Group'
If InStr(outSht.Cells(lRow2, 3), entry.Offset(, 1)) = 0 Then 'does name exist?
outSht.Cells(lRow2, 3) = outSht.Cells(lRow2, 3) & vbNewLine & entry.Offset(, 1)
End If
outSht.Cells(lRow2, 5) = outSht.Cells(lRow2, 5) & vbNewLine & entry.Offset(, -2)
outSht.Cells(lRow2, 6) = outSht.Cells(lRow2, 6) + entry.Offset(, 2)
ElseIf Not entry = prev And Not entry = "" And Not entry = "Company" Then
'-New row
prev = entry 'Save company name for comparison
outSht.Cells(lRow2 + 1, 1) = entry.Offset(, -3)
outSht.Cells(lRow2 + 1, 2) = "Payable" 'Where to get this value?
outSht.Cells(lRow2 + 1, 3) = entry.Offset(, 1)
outSht.Cells(lRow2 + 1, 4) = entry
outSht.Cells(lRow2 + 1, 5) = entry.Offset(, -2)
outSht.Cells(lRow2 + 1, 6) = entry.Offset(, 2)
End If
Next entry
outSht.Cells(lRow2 + 3, 1).Value = "Grand Total:"
outSht.Cells(lRow2 + 3, 2).Formula = "=SUM(F:F)"
End Sub
From the examples, this should handle the document all the way from the Sample to the target. I wanted to loop the value copying, but the change in column order made it annoying.
I have a data entry form and multiple data sheets named as Table1 and Table2.I want to modify data in a particular row in the selected datasheet using data entry form. In the data entry form, there are two buttons called SAVE and MODIFY buttons. First there is a option to select a table that I want to save data. Then I click modify button and it asks us to enter the serial number to make the modification. When I enter serial no of particular row in selected data sheet, all the details of that particular row should be appeared on the data entry form to modify and save it to the same row using SAVE button. But it gives a error mentioning that "no record found" and it can not detect the selection of datasheets. The VBA code that I have used for MODIFY button is given below. Please help me solve this problem sir.
Sub ModifyRecord()
Dim shTable As Worksheet
Dim shForm As Worksheet
Dim iCurrentRow As Integer
Dim sTableName As String
Set shForm = ThisWorkbook.Sheets("Form")
sTableName = shForm.Range("H7").Value
Set shTable = ThisWorkbook.Sheets(sTableName)
Dim irow As Long
Dim iSerial As Long
iSerial = Application.InputBox("Please enter Serial Number to make
modification.", "Modify", , , , , , 1)
On Error Resume Next
irow = Application.WorksheetFunction.IfError _
(Application.WorksheetFunction.Match(iSerial,
Sheets("sTableName").Range("A:A"), 0), 0)
On Error GoTo 0
If irow = 0 Then
MsgBox "No record found.", vbOKOnly + vbCritical, "No Record"
Exit Sub
End If
Sheets("Form").Range("L1").Value = irow
Sheets("Form").Range("M1").Value = iSerial
Sheets("Form").Range("H9").Value = Sheets("sTableName").Cells(irow, _
2).Value
Sheets("Form").Range("H11").Value = Sheets("sTableName").Cells(irow, _
3).Value
Sheets("Form").Range("H13").Value = Sheets("sTableName").Cells(irow, _
4).Value
Sheets("Form").Range("H15").Value = Sheets("sTableName").Cells(irow, _
5).Value
Sheets("Form").Range("H17").Value = Sheets("sTableName").Cells(irow, _
6).Value
Sheets("Form").Range("H19").Value = Sheets("sTableName").Cells(irow, _
7).Value
Sheets("Form").Range("H21").Value = Sheets("sTableName").Cells(irow, _
8).Value
Sheets("Form").Range("H23").Value = Sheets("sTableName").Cells(irow, _
9).Value
End Sub
I am looking for a way to shorten my code to input data from a form of 10 entries.
This is my userform with one RMA number (applies to all 10 PN), one customer name, 10 part numbers, and 10 serial numbers that go with each part number.
This is how I want data transferred to the worksheet.
The part number textboxes are named TB#.
The serial number textboxes are named SNTB#.
This is the code I have for the first entry. I was thinking of adding code to say "TB"&"i" and "SNTB"&"i", but I don't know where to place that statement or how to start it.
Private Sub EnterButton_Click()
'this assigns receiving data to first columns of log Sheet
If TB1.Value = "" Then
Else
Worksheets("RM Tracker").Activate
Dim lastrow
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastrow = lastrow + 1
Cells(lastrow, 1) = RMATB.Value
Cells(lastrow, 2) = CustCB.Value
Cells(lastrow, 3) = TB1.Value
Cells(lastrow, 4) = SNTB1.Value
Cells(lastrow, 5) = ReceiveTB.Value
ActiveCell.Offset(1, 0).Select
End If
ActiveWorkbook.Save
Call resetform
End Sub
Sub resetform()
RMATB.Value = ""
CustCB.Value = ""
TB1.Value = ""
SNTB1.Value = ""
ReceiveTB = ""
'sets focus on that first textbox again
RecForm.RMATB.SetFocus
End Sub
You can incorporate a for loop where "i" represents the row you are working with. When you are appending data you need to put that reference within the loop so the new row is recalculated.
Private Sub EnterButton_Click()
'this assigns receiving data to first columns of log Sheet
If TB1.Value = "" Then
Else
Worksheets("RM Tracker").Activate
dim i as long
For i = 1 To 10
Dim lastrow as long ' should put a data type with dim statements
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastrow = lastrow + 1
Cells(lastrow, 1) = Userform1.Controls("RMATB" & i).Value ' change userform name to fit your need
Cells(lastrow, 2) = Userform1.Controls("CustCB" & i).Value
Cells(lastrow, 3) = Userform1.Controls("TB1" & i).Value
Cells(lastrow, 4) = Userform1.Controls("SNTB1" & i).Value
Cells(lastrow, 5) = Userform1.Controls("ReceiveTB" & i).Value
Next i
End If
ActiveWorkbook.Save
Call resetform
End Sub
Sub resetform()
RMATB.Value = ""
CustCB.Value = ""
TB1.Value = ""
SNTB1.Value = ""
ReceiveTB = ""
'sets focus on that first textbox again
RecForm.RMATB.SetFocus
the code below works 100%. It scans for a match in Column B and copies and renames a group of cells when a match is found. However the is a line For lRow = Sheets("HR-Calc").Cells(Cells.Rows.count, "b").End(xlUp).Row To 7 Step -1
Where the step -1 will scan row by row from the bottom of the sheet until a match is found. It would be much easier if the step was set to End.(xlUp) instead of -1. searching every row is overkill because of how the data is set up End.(xlUp) would massive cut down the run time.
Is something like this possible?
Sub Fill_CB_Calc()
M_Start:
Application.ScreenUpdating = True
Sheets("summary").Activate
d_input = Application.InputBox("select first cell in data column", "Column Data Check", Default:="", Type:=8).Address(ReferenceStyle:=xlA1, RowAbsolute:=True, ColumnAbsolute:=False)
data_col = Left(d_input, InStr(2, d_input, "$") - 1)
data_row = Right(d_input, Len(d_input) - InStr(2, d_input, "$"))
Application.ScreenUpdating = False
Sheets("summary").Activate
Range(d_input).End(xlDown).Select
data_last = ActiveCell.Row
If IsEmpty(Range(data_col & data_row + 1)) = True Then
data_last = data_row
Else
End If
For j = data_row To data_last
CBtype = Sheets("summary").Range(data_col & j)
Sheets("HR-Calc").Activate
For lRow = Sheets("HR-Calc").Cells(Cells.Rows.count, "b").End(xlUp).Row To 7 Step -1
If Sheets("HR-Calc").Cells(lRow, "b") = CBtype Then
CBend = Sheets("HR-Calc").Range("C" & lRow).End(xlDown).Row + 1
Sheets("HR-Calc").Rows(lRow & ":" & CBend).Copy
CBstart = Sheets("HR-Calc").Range("c50000").End(xlUp).Row + 2
ActiveWindow.ScrollRow = CBstart - 8
Sheets("HR-Calc").Range("A" & CBstart).Insert Shift:=xlDown
CBold = Right(Range("c" & CBstart), Len(Range("C" & CBstart)) - 2)
box_name = Sheets("summary").Range(data_col & j).Offset(0, -10)
CBnew = Right(box_name, Len(box_name) - 2) & "-" ' <--this is custom and can be changed based on CB naming structure
If CBnew = "" Or vbCancel Then
End If
CBend2 = Range("c50000").End(xlUp).Row - 2
Range("C" & CBstart + 1 & ":" & "C" & CBend2).Select
Selection.Replace What:=CBold & "-", Replacement:=CBnew, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("C" & CBstart).FormulaR1C1 = "CB" & Left(CBnew, Len(CBnew) - 1)
GoTo M_Start2
Else
End If
Next lRow
M_Start2:
Next j
YN_result = MsgBox("Fill info for another block/inverter?", vbYesNo + vbExclamation)
If YN_result = vbYes Then GoTo M_Start
If YN_result = vbNo Then GoTo jumpout
jumpout:
' Sheets("summary").Range(d_input).Select
Application.ScreenUpdating = True
End Sub
I'm not sure if this will help but I've had a great performance increase with pulling the entire range you need to loop through into a variant array and then looping through the array. If I need to loop through large data sets, this method has worked out well.
Dim varArray as Variant
varArray = Range(....) 'set varArray to the range you're looping through
For y = 1 to uBound(varArray,1) 'loops through rows of the array
'code for each row here
'to loop through individual columns in that row, throw in another loop
For x = 1 to uBound(varArray, 2) 'loop through columns of array
'code here
Next x
Next y
You can also define the column indexes prior to executing the loop. Then you only need to execute the you need to pull those directly in the loop.
'prior to executing the loop, define the column index of what you need to look at
Dim colRevenue as Integer
colRevenue = 5 'or a find function that searches for a header named "Revenue"
Dim varArray as Variant
varArray = Range(....) 'set varArray to the range you're looping through
For y = 1 to uBound(varArray,1) 'loops through rows of the array
tmpRevenue = CDbl(varArray(y, colRevenue))
Next y
Hope this helps.
Look at doing a .find from the bottom up.
Perform a FIND, within vba, from the bottom of a range up
That will eliminate the need to do the for loop from the last row to the first occurrence of the value you want to locate.
Right now, I have a code that will generate a name for a folder in a network drive. Once the user types in the name for the new folder in a prompt box, I am trying to add the name into two places: the bottom of a list in a column, and to the end of the list in the first row (the first empty cell in the row)
Currently, my code to put the name at the bottom of the list in column D works:
lMaxRows = Cells(Rows.Count, "D").End(xlUp).Row
Range("D" & lMaxRows + 1) = accountname
where "accountname" is the input that the prompt asks for. Then the code goes to the last cell that was used in the column, goes one additional cell, and fills it with the "accountname".
Is there a way to convert this code to work for a list in a row? I'm trying to build the list from left to right starting in column X of row 1. This is what I have right now, but it's not working and I'm not sure if it's a language issue or something more.
lMaxCol = Cells(1, Columns.Count).End(xlToRight).Column
Range("X1" & lMaxCol + 1) = accountname
Any ideas? Is this a quick fix or will it require a more sophistacted code?
-AC
lMaxCol = Cells(1, Columns.Count).End(xlToRight).Offset(0,1).Column
If lMaxCol<26 Then lMaxCol=26
Cells(1, lMaxCol) = accountname
Dim lMaxCol As Long
With ActiveSheet.Rows(1) 'might want a different sheet
lMaxCol = .Find(what:="", after:=[w1], LookIn:=xlValues, searchdirection:=xlNext).Column
End With
Cells(1, lMaxCol) = AccountName
Note that this should, indeed, find the first empty cell at or after X1. If there is, for example, data in X1 and AA1, the above will return 25, not 28. If this might be an issue, and you prefer to return 28 in that case, you could use something like:
Dim lMaxCol As Long
With ActiveSheet.Range("x1", Cells(1, Columns.Count))
On Error Resume Next
lMaxCol = .Find(what:="*", after:=.Cells(1, .Columns.Count), LookIn:=xlValues, _
searchdirection:=xlPrevious).Column + 1
If Err.Number <> 0 Then lMaxCol = 24
On Error GoTo 0
End With
Cells(1, lMaxCol) = AccountName
If you don't need to know lMaxCol for some other part of the code, this code can be simplified.
Dim C As Range
With ActiveSheet.Range("x1", Cells(1, Columns.Count))
Set C = .Find(what:="*", after:=.Cells(1, .Columns.Count), LookIn:=xlValues, _
searchdirection:=xlPrevious)
If Not C Is Nothing Then
C.Offset(0, 1) = AccountName
Else
Cells(1, 24) = AccountName
End If
End With