If Column 2 is equal ChosenDate when the button is clicked, the Label Box in VBA will display all the row data of Column 6. But I can only display one data. and if the value ChosenDate is changed the data diplayed in Label Box will also be changed.
Dim DateChosen As Date
Dim i As Integer
DateChosen = "2020/07/20"
For i = 10 To 5000
If Cells(i, 2).Value = DateChosen Then
EventLabel.Caption = Range("F" & i)
End If
Next i
Try replacing of
EventLabel.Caption = Range("F" & i)
with
EventLabel.Caption = EventLabel.Caption & Range("F" & i) & VbCrLf 'to be displayed one on top of the other
or
EventLabel.Caption = EventLabel.Caption & Range("F" & i) & ", "' to be dsplayed one after the other
Edited:
In order to keep only the last iteration/processing result, your code must previously clear the caption:
EventLabel.Caption = ""
For i = 10 To 5000
If Cells(i, 2).Value = DateChosen Then
EventLabel.Caption = EventLabel.Caption & Range("F" & i) & VbCrLf
End If
Next i
Try below sub.
Sub MultiLineLabel()
Dim DateChosen As Date
Dim i As Integer
Dim myCaption
DateChosen = "2020/07/20"
For i = 10 To 5000
If Cells(i, 2).Value = DateChosen Then
myCaption = myCaption & Range("F" & i) & vbNewLine
End If
Next i
EventLabel.Caption = myCaption
End Sub
Related
I have a macro that open a closed workbook
sends data to this workbook, saves, then closes
sometimes it fails to send some of the data, or All of the data.
But doesn't throw ant error messages.
Public Sub PushUpdate315_CLIP()
If Range("H49").Value = "QCS UPLOADED" Then
MsgBox ("QCS had already been uploaded, if you believe this is an error, Please see Supervisor")
Exit Sub
End If
If Range("G54").Value = "" Then
Dim coreTime As Long
Dim lidTime As Long
Dim caseTime As Long
Dim finalTime As Long
coreValue = Range("L13").Value
lidValue = Range("L19").Value
caseValue = Range("L23").Value
finalValue = Range("L44").Value
If coreValue <= 0.0034722 Then
MsgBox ("Core Time is NOT Valid")
Exit Sub
End If
If lidValue <= 1.04166666666667E-02 Then
MsgBox ("Lid Time is NOT Valid")
Exit Sub
End If
If caseValue <= 0.002777778 Then
MsgBox ("Case Time is NOT Valid")
Exit Sub
End If
If finalValue <= 0.006944444 Then
MsgBox ("Final Time is NOT Valid")
Exit Sub
End If
End If
'315 Push update
Dim serverFileName As String 'obtain url for sharepoint filename, insert below
Dim x As New Excel.Application 'make a new session for the sharepoint version
Dim w As Workbook 'grab-handle for the sharepoint file
x.Visible = True
x.ScreenUpdating = True
serverFileName = "SUPERSECRETLINK HERE/Module Impedances.xlsx"
Set w = x.Workbooks.Open(serverFileName) 'open the sharepoint version
w.Save
Application.Wait (Now + TimeValue("0:00:1"))
If sheetExists(Range("B6").Text, w) Then
'w.Sheets(Range("B6").Text).Range("A2").Value = "test"
lastrow = w.Sheets(Range("B6").Text).Range("A10000").End(xlUp).Row + 1
w.Sheets(Range("B6").Text).Range("A" & lastrow).Value = Range("B5").Text ' WO
w.Sheets(Range("B6").Text).Range("B" & lastrow).Value = Range("B7").Text ' Serial
w.Sheets(Range("B6").Text).Range("D" & lastrow).Value = Range("D11").Text ' Core Imp
'w.Sheets(Range("B6").Text).Range("E" & lastrow).Value = Range("D28").Text ' Take Off Imp
w.Sheets(Range("B6").Text).Range("F" & lastrow).Value = Range("D26").Text ' Term Imp
w.Sheets(Range("B6").Text).Range("G" & lastrow).Value = Range("H13").Text ' Core Time
w.Sheets(Range("B6").Text).Range("H" & lastrow).Value = Range("H19").Text ' Case Time (lid)
w.Sheets(Range("B6").Text).Range("I" & lastrow).Value = Range("H23").Text ' mini bms (Sink Core)
w.Sheets(Range("B6").Text).Range("J" & lastrow).Value = Range("H44").Text 'cabling time (finsihing)
w.Sheets(Range("B6").Text).Range("K" & lastrow).Value = Range("H45").Text ' balance time
'w.Sheets(Range("B6").Text).Range("L" & lastrow).Value = Range("H36").Text ' testing
w.Sheets(Range("B6").Text).Range("M" & lastrow).Value = Range("I47").Text ' total labor
w.Sheets(Range("B6").Text).Range("N" & lastrow).Value = Range("I49").Text ' total labor with waiting
w.Sheets(Range("B6").Text).Range("O" & lastrow).Value = Range("I49").Text ' total lead time
w.Sheets(Range("B6").Text).Range("P" & lastrow).Value = (Range("H13").Value) * 1440
w.Sheets(Range("B6").Text).Range("P" & lastrow).NumberFormat = "General"
w.Sheets(Range("B6").Text).Range("Q" & lastrow).Value = (Range("H19").Value) * 1440
w.Sheets(Range("B6").Text).Range("Q" & lastrow).NumberFormat = "General"
w.Sheets(Range("B6").Text).Range("R" & lastrow).Value = (Range("H23").Value) * 1440
w.Sheets(Range("B6").Text).Range("R" & lastrow).NumberFormat = "General"
w.Sheets(Range("B6").Text).Range("S" & lastrow).Value = (Range("H44").Value) * 1440
w.Sheets(Range("B6").Text).Range("S" & lastrow).NumberFormat = "General"
w.Sheets(Range("B6").Text).Range("T" & lastrow).Value = (Range("H45").Value) * 1440
w.Sheets(Range("B6").Text).Range("T" & lastrow).NumberFormat = "General"
w.Sheets(Range("B6").Text).Range("V" & lastrow).Value = (Range("I47").Value) * 1440
w.Sheets(Range("B6").Text).Range("V" & lastrow).NumberFormat = "General"
w.Sheets(Range("B6").Text).Range("W" & lastrow).Value = (Range("I49").Value) * 1440
w.Sheets(Range("B6").Text).Range("W" & lastrow).NumberFormat = "General"
w.Sheets(Range("B6").Text).Range("X" & lastrow).Value = (Range("I49").Value) * 1440
w.Sheets(Range("B6").Text).Range("X" & lastrow).NumberFormat = "General"
w.Sheets(Range("B6").Text).Range("Y" & lastrow).Value = MonthName(Month(Range("G44").Text), True)
w.Sheets(Range("B6").Text).Range("Z" & lastrow).Value = Year(Range("G44").Text)
w.Sheets(Range("B6").Text).Range("AA" & lastrow).Value = MonthName(Month(Range("G44").Text), True) + CStr(Year(Range("G44").Text))
w.Sheets(Range("B6").Text).Range("AG" & lastrow).Value = Range("G44").Text
w.Save
w.Close
x.Quit
MsgBox ("Data sent to Metrics")
Range("H49").Value = "QCS UPLOADED"
BuildUnit
Else
MsgBox ("This Battery Type does not exists yet in the databse, Please contact QCS Site data admin")
End If
On Error Resume Next
Workbooks("Macros.xlsm").Close
On Error GoTo 0
End Sub
Its really strange how some values get sent and others dont.
for example:
w.Sheets(Range("B6").Text).Range("F" & lastrow).Value = Range("D26").Text ' Term Imp
w.Sheets(Range("B6").Text).Range("G" & lastrow).Value = Range("H13").Text ' Core Time
w.Sheets(Range("B6").Text).Range("H" & lastrow).Value = Range("H19").Text ' Case Time (lid)
w.Sheets(Range("B6").Text).Range("I" & lastrow).Value = Range("H23").Text ' mini bms (Sink Core)
I've literally seen where the first and last value get sent but not the ones the middle?
I have cells that are supposed to be 0 I believe. 7.45058059692383E-12.
How do I make these 0 in my code?
Sheets("MainData").Range("C" & i) = Sheets("CM_MainData").Range("C" & i)
I thought converting NumberFormat to 0 may help but it did not work.
Sheets("MainData").Range("C" & i) = Sheets("CM_MainData").Range("C" & i).NumberFormat = "0.00"
Instead the result is FALSE
Please Help!
Full code:
Sub CopyData()
Worksheets("MainData").Rows("2:" & Rows.Count).ClearContents
'Copy data from the CM Commentary File to Template
Application.ScreenUpdating = False
Set MainDataCM = Workbooks.Open(Sheets("Input").Range("B3") & Sheets("Input").Range("B6"))
MainDataCM.Sheets("Main Data").Copy After:=ThisWorkbook.Sheets(1)
MainDataCM.Close savechanges:=False
Application.ScreenUpdating = True
Sheets("Main Data").Name = "CM_MainData"
Worksheets("CM_MainData").Visible = False
'Read the CM_MainData tab and copy the required columns in the MainData tab
Dim k As Long
k = Sheets("CM_MainData").Range("A1", Sheets("CM_MainData").Range("A1").End(xlDown)).Rows.Count
Debug.Print (k)
i = 2
While i <= k
Sheets("MainData").Range("A" & i) = Sheets("CM_MainData").Range("A" & i)
Sheets("MainData").Range("B" & i) = Sheets("CM_MainData").Range("B" & i)
Sheets("MainData").Range("C" & i) = Sheets("CM_MainData").Range("C" & i).NumberFormat = "0.00"
Sheets("MainData").Range("D" & i) = Sheets("CM_MainData").Range("D" & i)
Sheets("MainData").Range("E" & i) = Sheets("CM_MainData").Range("C" & i) * 1000
Sheets("MainData").Range("F" & i) = Sheets("CM_MainData").Range("H" & i)
'Sheets("MainData").Range("E" & i).NumberFormat = "0.00"
If Sheets("MainData").Range("F" & i) = "" Then
Sheets("MainData").Range("F" & i) = "RBC INVESTOR SERV O/H & MISC"
End If
i = i + 1
Wend
Worksheets("Macro").Activate
Worksheets("Macro").Select
MsgBox "Step 1 Completed"
End Sub
Value transfer:
Sheets("MainData").Range("C" & i).Value = Sheets("CM_MainData").Range("C" & i).Value
Number format (a separate step, and does not change the underlying value):
Sheets("MainData").Range("C" & i).NumberFormat = "0.00"
Or use WorksheetFunction.Round (does change the underlying value).
Sheets("MainData").Range("C" & i).Value = WorksheetFunction.Round(Sheets("CM_MainData").Range("C" & i).Value, 2)
i have 3 columns in excel with the values Name / City / Birthday i try to create an inputbox where i can type in the Name and a second one where i will type in the birth date so that the result that will show up in the 'th column will be City+Birthday only for the name used in the first imputbox.
i tried this but it didn't work
Sub fill_next()
For i = 2 To 10
If InputBox("vam", "val") = Range("A" & i).Value Then
Range("E" & i).Value = Range("B" & i) & InputBox("enter number", "value baliz")
End If
Next i
End Sub
Range("B" & i) contained a dropdown list and InputBox(...) a variable that is added to the text i solved the problem
the isue was in Range("B" & i) the dropdown list wasn't detected and i specified the cells in the code. thanks everyone
Sub fill_next()
For i = 1 To 8
If Range("A" & 15).Value = Range("A" & i).Value Then
Range("A" & 21).Value = Range("B" & 15) & "*" & InputBox("enter restaure date", "Consultation") & "*""" & Range("C" & 15).Value
End If
Next i
End Sub
Morning guys,
I have recently been tasked with being the person to update and monitor any VBA issues my currently company has, as the previous employee who was doing such has no left and there are no immediate plans to hire a replacement. Unfortunately my excel and VBA skills are rudimentary put politely, and youtube has only been able to help so much.
There is a macro used in one of the spreadsheets which checks and overwrites certain month end figures. This part of the macro runs fine, and when completed for each client an X should be input to column M (Labelled done) to signify this is done. The column N (labelled skip) is already filled with an X for those that should be skipped due to individual client technicalities.
The macro however appears to be filling in column N with the value x for when a client check is done. Have any of you ever encountered a similar issue with values being incorrectly assigned to the adjacent column?
Sub Values()
Application.ScreenUpdating = False
Dim EndRow As Integer
Dim i As Integer
Dim ValueDate As Date
Dim Cash As Double
Dim Value As Double
Dim APXRef As String
Dim d As Integer
Dim Overwrite As Boolean
Overwrite = Worksheets("Summary").Range("Y2").Value ' from checkboxes
EndRow = Range("J2").End(xlDown).Row
ValueDate = Range("P6").Value
If MsgBox("You are uploading with the following date: " & ValueDate & ", do
you want to continue?", vbYesNo) = vbNo Then Exit Sub
For i = 2 To EndRow
APXRef = Range("J" & i).Value
Value = Range("L" & i).Value
If Range("M" & i) = "" And Range("N" & i) = "" Then
Worksheets("Summary").Activate
r = Range("A:A").Find(APXRef).Row
Range("B" & r).Select
Call GoToClient
d = Range("A10").End(xlDown).Row
If Range("A" & d).Value < ValueDate Then
Range("A" & d + 1).Value = ValueDate
Range("B" & d + 1).Value = Value
Range("D" & d + 1).FormulaR1C1 = "=((RC[-2]/(R[-1]C[-2]+RC[-1]))-1)*100"
Range("E" & d + 1).FormulaR1C1 = "=((((R[-1]C)*(RC[-1]))/100)+R[-1]C)"
Range("H" & d + 1).Value = Range("H" & d).Value
'Save client
If Overwrite = True Then
Call SaveClient
End If
'Return to Flow Tab
Worksheets("Flows").Activate
Range("M" & i).Value = "x"
Else
'skip
Worksheets("Flows").Activate
Range("N" & i).Value = "x"
End If
End If
Application.StatusBar = TabRef & " " & Round(((i - 1) / (EndRow - 1)) *
100, 1) & "% Complete"
Next i
Application.StatusBar = "Value Update Complete"
End Sub
I would like to change the data values of textboxes by using a spinbutton
The data are written in an Excel table ..... could you explain to me which
syntax I should use or perhaps could you show me an example?
Private Sub SpinButton1_Change()
'Range("G15").Value = SpinButton1.Value
Dim I As Integer
For I = 2 To 10 Step 1
TextBox2.Value = Ws.Range("A"& I)
Next
Using the following code i gives a good result but but why do i need an msgbox ? Without msgbox it doesn't function ... strange ...
Private Sub SpinButton1_Change()
Dim I As Integer
For I = 2 To 10 Step 1
MsgBox ("La valeur de la Textbox" & I & " est de " & TextBox2)
ComboBox1.Value = Ws.Range("A" & I)
ActiveCell = Me.ComboBox1.Value
TextBox2.Value = Ws.Range("B" & I)
TextBox3.Value = Ws.Range("C" & I)
TextBox4.Value = Ws.Range("D" & I)
TextBox5.Value = Ws.Range("E" & I)
TextBox6.Value = Ws.Range("F" & I)
TextBox7.Value = Ws.Range("G" & I)
TextBox8.Value = Ws.Range("H" & I)
TextBox9.Value = Ws.Range("I" & I)
'Range("G15").Value = SpinButton1.Value
Next