Essentially, I want to insert a timestamp for each row in column A if any other cells in that row are NOT blank. I want this to executive under my Sub PASTE() all at once.
I have a sub running which executives pasting specifics values to from columns to B:K on each row. I'd like this to finish running and then have it insert the timestamp for when it finished it column A. This way I can keep track of my analysis results, paste them in a worksheet and then timestamp them.
Sub PASTE()
erw = Sheet8.Cells(1, 1).CurrentRegion.Rows.Count + 1
If Len(Range("D50")) <> 0 Then
Sheet8.Cells(erw, 2) = Sheet2.Range("D50")
Sheet8.Cells(erw, 3) = Sheet2.Range("D51")
Sheet8.Cells(erw, 4) = Sheet2.Range("D52")
Sheet8.Cells(erw, 5) = Sheet2.Range("D53")
Sheet8.Cells(erw, 6) = Sheet2.Range("D54")
Sheet8.Cells(erw, 7) = Sheet2.Range("D55")
Sheet8.Cells(erw, 8) = Sheet2.Range("D56")
Sheet8.Cells(erw, 9) = Sheet2.Range("D57")
Sheet8.Cells(erw, 10) = Sheet2.Range("D58")
Sheet8.Cells(erw, 11) = Sheet2.Range("D59")
Sheet8.Cells(erw, 12) = Sheet2.Range("D60")
Sheet8.Cells(erw, 13) = Sheet2.Range("D61")
Sheet2.Range("D50") = ""
Sheet2.Range("D51") = ""
Sheet2.Range("D52") = ""
Sheet2.Range("D53") = ""
Sheet2.Range("D54") = ""
Sheet2.Range("D55") = ""
Sheet2.Range("D56") = ""
Sheet2.Range("D57") = ""
Sheet2.Range("D58") = ""
Sheet2.Range("D59") = ""
Sheet2.Range("D60") = ""
Sheet2.Range("D61") = ""
Else
MsgBox "You must enter the values"
End If
End Sub
Related
I have a form with two different listboxes. One for downtime data and one for production data. I can add new data and delete data via both listboxes. I can edit a selected row as well. The problem I'm running into is that after I edit and update a row for the production listbox and then enter in new data for new row it keeps putting that data in the last row I edited. If I don't edit a row then anytime I add new data it automatically goes to the next row. This doesn't happen with the downtime section, only the production section. With the downtime section everything works as it should. Attached is the workbook. Any help is greatly appreciated.
This is the code to update the listbox with what was entered into the text boxes above the listbox.
Sub Prod_Submit()
Dim sh As Worksheet
Dim iRow As Long
Set sh = ThisWorkbook.Sheets("ADHData")
If MainForm.txtRowNumberProd.Value = "" Then
iRow = [Counta(ADHData!A:A)] + 1
Else
iRow = MainForm.txtRowNumberProd.Value
End If
With sh
.Cells(iRow, 1) = MainForm.OrderA.Value
.Cells(iRow, 2) = MainForm.StockA.Value
.Cells(iRow, 3) = MainForm.FaceA.Value
.Cells(iRow, 4) = MainForm.LinerA.Value
.Cells(iRow, 5) = MainForm.WidthA.Value
.Cells(iRow, 6) = MainForm.PrevContA.Value
.Cells(iRow, 7) = MainForm.ContA.Value
.Cells(iRow, 8) = MainForm.PrevGoodA.Value
.Cells(iRow, 9) = MainForm.GoodA.Value
End With
End Sub
This is my code for selecting the row that needs to be edited
Private Sub CommandButton2_Click()
If Select_Prod = 0 Then
MsgBox "No row is selected.", vbOKOnly + vbInformation, "Edit"
Exit Sub
End If
MainForm.txtRowNumberProd.Value = Select_Prod + 1
MainForm.OrderA.Value = MainForm.Production_TableA.List(MainForm.Production_TableA.ListIndex, 0)
MainForm.StockA.Value = MainForm.Production_TableA.List(MainForm.Production_TableA.ListIndex, 1)
MainForm.FaceA.Value = MainForm.Production_TableA.List(MainForm.Production_TableA.ListIndex, 2)
MainForm.LinerA.Value = MainForm.Production_TableA.List(MainForm.Production_TableA.ListIndex, 3)
MainForm.WidthA.Value = MainForm.Production_TableA.List(MainForm.Production_TableA.ListIndex, 4)
MainForm.PrevContA.Value = MainForm.Production_TableA.List(MainForm.Production_TableA.ListIndex, 5)
MainForm.ContA.Value = MainForm.Production_TableA.List(MainForm.Production_TableA.ListIndex, 6)
MainForm.PrevGoodA.Value = MainForm.Production_TableA.List(MainForm.Production_TableA.ListIndex, 7)
MainForm.GoodA.Value = MainForm.Production_TableA.List(MainForm.Production_TableA.ListIndex, 8)
MsgBox "Please make the required changes and update the new production data.", vbOKOnly + vbInformation, "Edit"
End Sub
And this is my Select_Prod Code
Function Select_Prod() As Long
Dim i As Long
Select_Prod = 0
For i = 0 To MainForm.Production_TableA.ListCount - 1
If MainForm.Production_TableA.Selected(i) = True Then
Select_Prod = i + 1
Exit For
End If
Next i
End Function
And my code to reset the textboxes
Sub Prod_Reset()
Dim iRow As Long
iRow = [Counta(ADHData!A:A)] + 1 ' idetifying the last row
With MainForm
MainForm.OrderA.Value = ""
MainForm.StockA.Value = ""
MainForm.FaceA.Value = ""
MainForm.LinerA.Value = ""
MainForm.WidthA.Value = ""
MainForm.PrevContA.Value = ""
MainForm.ContA.Value = ""
MainForm.PrevGoodA.Value = ""
MainForm.GoodA.Value = ""
.Production_TableA.ColumnCount = 9
.Production_TableA.ColumnHeads = True
.Production_TableA.ColumnWidths = "55,55,70,71,50,106,77,69,42"
If iRow > 1 Then
.Production_TableA.RowSource = "ADHData!A2:J" & iRow
Else
.Production_TableA.RowSource = "ADHData!A2:J21"
End If
End With
End Sub
I get a runtime error of 1004, unable to get the match property of the worksheet function class when I select an item from my list box to edit with a edit button.
the debug highlights the problem child. I realize that if the first column has data in it, it will work without issue, if it has no data, then it will fail.
I starred the line that is highlighted. I understand it is failing to match what is in the first column. Is there a way to make it run if there is any data in the row period? there are times there isn't data to input at first in the first column.
or should I make a hidden column with a auto incrementing number so the first column always has data?
Further details on what this is doing. I am assigning a value to a textbox so it can be used to identify what row I am actively working on. it does this by assigning the first column A:A to the txtRowNumber. If no item is selected from the listbox, the macro will just select the next empty row as shown below in the subroutine submit().
my goal is to be able to select the row regardless if there is data in the first column or not. I want to be able to continue with editing and saving any row selected
thank you!
Private Sub EditButton_Click()
If selected_list = 0 Then
MsgBox "No Row has been selected", vbkonly + vbInformation, "Edit"
Exit Sub
End If
'code to update the value to respective controls
*Me.txtRowNumber.Value = Application.WorksheetFunction.Match(Me.LstDataBase.List(Me.LstDataBase.ListIndex, 0), ThisWorkbook.Sheets("Active").Range("A:A"), 0)*
Me.SctaskInput.Value = Me.LstDataBase.List(Me.LstDataBase.ListIndex, 0)
Me.TechInput.Value = Me.LstDataBase.List(Me.LstDataBase.ListIndex, 1)
Me.CustomerInput.Value = Me.LstDataBase.List(Me.LstDataBase.ListIndex, 2)
Me.SectionInput.Value = Me.LstDataBase.List(Me.LstDataBase.ListIndex, 3)
Me.OldSNInput.Value = Me.LstDataBase.List(Me.LstDataBase.ListIndex, 4)
Me.OldBTInput.Value = Me.LstDataBase.List(Me.LstDataBase.ListIndex, 5)
Me.OldModelInput.Value = Me.LstDataBase.List(Me.LstDataBase.ListIndex, 6)
Me.NewSNInput.Value = Me.LstDataBase.List(Me.LstDataBase.ListIndex, 7)
Me.NewBTInput.Value = Me.LstDataBase.List(Me.LstDataBase.ListIndex, 8)
Me.NewModelInput.Value = Me.LstDataBase.List(Me.LstDataBase.ListIndex, 9)
Me.StatusInput.Value = Me.LstDataBase.List(Me.LstDataBase.ListIndex, 10)
End Sub
Sub Submit()
Dim sh As Worksheet
Dim iRow As Long
Set sh = ThisWorkbook.Sheets("Active")
If frmform.txtRowNumber.Value = "" Then
iRow = [counta(Active!A:A)] + 1
Else
iRow = frmform.txtRowNumber.Value
End If
With sh
.Cells(iRow, 1) = frmform.SctaskInput.Value
.Cells(iRow, 2) = frmform.TechInput.Value
.Cells(iRow, 3) = frmform.CustomerInput.Value
.Cells(iRow, 4) = frmform.SectionInput.Value
.Cells(iRow, 5) = frmform.OldSNInput.Value
.Cells(iRow, 6) = frmform.OldBTInput.Value
.Cells(iRow, 7) = frmform.OldModelInput.Value
.Cells(iRow, 8) = frmform.NewSNInput.Value
.Cells(iRow, 9) = frmform.NewBTInput.Value
.Cells(iRow, 10) = frmform.NewModelInput.Value
.Cells(iRow, 11) = frmform.StatusInput.Value
.Cells(iRow, 14) = IIf(frmform.YesOpt.Value = True, "Yes", "No")
.Cells(iRow, 15) = [text(Now(), "YYYY/MM/DD HH:MM:SS")]
.Cells(iRow, 16) = Application.UserName
End With
End Sub
Application.WorksheetFunction.Match will return a runtime error if the search value is not found.
The usual way to handle that is
Dim idx As Long
On Error Resume Next
idx = Application.WorksheetFunction.Match(Me.LstDataBase.List(Me.LstDataBase.ListIndex), ThisWorkbook.Sheets("Active").Range("A:A"), 0)
On Error GoTo 0
If idx = 0 Then
' value not found, now what?
Else
Me.txtRowNumber.Value = idx
End If
So I made an excel sheet with a button to add/remove stock and add a new line if the stock you entered isn't in the system yet. This was done through a combo box. I have a line which pastes the combo box value (for when a new item is added) and essentially duplicated this in another cell but for some reason it's sending me an application or object error.
Dim C As Range
With lstRng
Set C = .Find(cbxList.Value, LookIn:=xlValues)
If C Is Nothing Then
Range("a65536").End(xlUp).Offset(1, 0).Value = cbxList.Value #this one works and adds to the end of my stock list
Range("b65536").End(xlUp).Offset(1, 0).Value = tbxStock.Value
Range("aa65536").End(xlUp).Offset(1, 0).Value = "Stock in"
Range("ab65536").End(x1Up).Offset(1, 0).Value = cbxList.Value
Range("ac65536").End(xlUp).Offset(1, 0).Value = tbxStock.Value
Range("ad65536").End(xlUp).Offset(1, 0).Value = txtDate.Value
Range("ae65536").End(xlUp).Offset(1, 0).Value = txtRequest.Value
Range("af65536").End(xlUp).Offset(1, 0).Value = txtAllocate.Value
Range("ag65536").End(xlUp).Offset(1, 0).Value = txtReason.Value
Me.cbxList.Value = ""
Me.tbxStock.Value = ""
Me.txtDate.Value = ""
Me.txtRequest.Value = ""
Me.txtAllocate.Value = ""
Me.txtReason.Value = ""
ElseIf Not C Is Nothing Then
C.Offset(0, 1).Value = C.Offset(0, 1).Value + tbxStock.Value
Range("aa65536").End(xlUp).Offset(1, 0).Value = "Stock in"
Range("ab65536").End(x1Up).Offset(1, 0).Value = cbxList.Value #the error is here for this piece. If I mouse over the "cbxList.Value" it shows me the value I entered and if I mouse over the previous bit it gives me - = <Application-defined or Object-defined error>
Range("ac65536").End(xlUp).Offset(1, 0).Value = tbxStock.Value
Range("ad65536").End(xlUp).Offset(1, 0).Value = txtDate.Value
Range("ae65536").End(xlUp).Offset(1, 0).Value = txtRequest.Value
Range("af65536").End(xlUp).Offset(1, 0).Value = txtAllocate.Value
Range("ag65536").End(xlUp).Offset(1, 0).Value = txtReason.Value
End If
End With
Me.cbxList.Value = ""
Me.tbxStock.Value = ""
Me.txtDate.Value = ""
Me.txtRequest.Value = ""
Me.txtAllocate.Value = ""
Me.txtReason.Value = ""
End Sub
I've this macro in an UserForm to register accounting operations, after I finish the registration and I click the "x" button in the Userform my excel workbook close without asking me. I know this piece of code is the problem because my Userform do other things and these other things don't cause this problem.
Confirmar = MsgBox("¿Desea registrar la nueva operación contable?", vbYesNo)
If Confirmar = vbYes Then
Next_LibroDiario = WShe_LibroDiario.Cells(Rows.Count, 2).End(xlUp).Row + 1
If APP_RegistroContable.OptionButton_Débito = True Then
WShe_LibroDiario.Cells(Next_LibroDiario, 7) = APP_RegistroContable.Monto + 0
APP_RegistroContable.Monto = ""
ElseIf APP_RegistroContable.OptionButton_Crédito = True Then
WShe_LibroDiario.Cells(Next_LibroDiario, 8) = APP_RegistroContable.Monto + 0
APP_RegistroContable.Monto = ""
ElseIf APP_RegistroContable.OptionButton_Débito = False _
And APP_RegistroContable.OptionButton_Crédito = False _
Then
MsgBox "Please select an accounting item"
Exit Sub
End If
WShe_LibroDiario.Cells(Next_LibroDiario, 2) = APP_RegistroContable.Ctas_Bancarias
APP_RegistroContable.Ctas_Bancarias = ""
WShe_LibroDiario.Cells(Next_LibroDiario, 3) = CDate(APP_RegistroContable.Fecha)
APP_RegistroContable.Fecha = ""
WShe_LibroDiario.Cells(Next_LibroDiario, 4) = APP_RegistroContable.Recibo_CF
APP_RegistroContable.Recibo_CF = ""
WShe_LibroDiario.Cells(Next_LibroDiario, 5) = APP_RegistroContable.Nombre
APP_RegistroContable.Nombre = ""
WShe_LibroDiario.Cells(Next_LibroDiario, 6) = APP_RegistroContable.Auxiliar + 0
WShe_LibroDiario.Cells(Next_LibroDiario, 9) = APP_RegistroContable.Clasificación
APP_RegistroContable.Clasificación = ""
WShe_LibroDiario.Cells(Next_LibroDiario, 10) = APP_RegistroContable.Comentario
APP_RegistroContable.Comentario = ""
' This part creates an ID for the accounting operation using the date registered and the number of
' operations registered in that date
Last_ID = WShe_LibroDiario.Cells(Rows.Count, 2).End(xlUp).Row
Set Rang_Fecha = WShe_LibroDiario.Range("C8:C" & Last_ID)
Set Rang_ID = WShe_LibroDiario.Cells(Last_ID, 3)
Inte_IDGenerator = WorksheetFunction.CountIf(Rang_Fecha, Rang_ID)
WShe_LibroDiario.Cells(Last_ID, 1).Value = WShe_LibroDiario.Cells(Last_ID, 3).Value & "-0" & _
Inte_IDGenerator
MsgBox "The accounting operation is now in the system"
End if
Compiler Error: End With Has No With. I know that this is wrong, and there is something in my code in where I am not calling it correctly that is making it mess up but I cannot find it. I'm just trying to grab information off of my sheet1 so that I can use it later on.
With ThisWorkbook.Sheets("Sheet1")
While (Counter <= 300)
Pcounter = .Cells(ACBoxCounter, 2)
If (Pcounter <> "") Then
ACounter = ACounter + 1
End If
ACBCounter = ACBCounter + 30
Wend
While (OverallACounter < ACounter)
Set objStream = CreateObject("ADODB.Stream")
objStream.Charset = "iso-8859-1"
objStream.Open
ExampleString = .Cells(Row2Counter + 22, 3)
ChooseM = Split(ExampleString, "-")(1)
If (ChooseM = "8")
M = "II"
P = 97
Label = .Cells(Row2Counter, 2)
ElseIf (ChooseM = "13") Then
Model = "A II"
P = 10
Label = "A6_" & .Cells(Row2Counter, 2)
ElseIf (ChooseM = "19") Then
M = "AC1I"
P = 56
Label = "A9_" & .Cells(Row2Counter, 2)
End If
OverallD = 0
Overall= 0
OverallB = 0
ChooseBoxType = Split(ExampleString, "-")(2)
If ((StrComp(ChooseB, "1") = 0) Or (StrComp(ChooseB, "1M") = 0)) Then
BoxInputT= "1 Phase"
ElseIf ((StrComp(ChooseB, "2") = 0) Or (StrComp(ChooseB, "2M") = 0)) Then
BoxInput= "2"
ElseIf ((StrComp(ChooseB ,"3") = 0) Or (StrComp(ChooseBo, "3M") = 0)) Then
BoxInput= "3"
End If
objStream.WriteText (" <" & .Cells(Row2Counter, 2).Text & ">" & vbLf)
Wend
End With
Compiler Error: End With Has No With