Inserting 3 Excel columns into 1 label - excel

I have three columns of data. Is there a way using vba to insert the information into a label on a userForm?
Here is the updated code I have:
Dim rowNum As Integer
Dim lastRow As Integer
lastRow = 373
For rowNum = 2 To lastRow
report = Sheets("DATA2").Range("F" & rowNum).Text & _
" " & Sheets("DATA2").Range("G" & rowNum).Text & _
" " & Sheets("DATA2").Range("H" & rowNum).Text & vbCrLf
Next rowNum
End Sub

Try:
Dim rowNum as Integer 'loop counter
Dim lastRow as Integer
lastRow = 'some code to set the row number of the bottom row
For rowNum = 1 to lastRow
With ActiveWorksheet
myLabel.Text = myLabel.Text & .Range("A" & rowNum).Text & " " & .Range("B" & rowNum).Text & " " & .Range("C" & rowNum).Text & vbCrLf
End With
Next rowNum
EDIT
Updated to append each loop instead of over-writing

Assuming that your label can handle multiple lines, you could write a loop that iterates through each column of data and appends it to a String as a new line, and then set the text field of that label to the string you created.

Related

Test if String Contains Substring

I have a substring in the column "A" of Sheet2, which I take using the LEFT Function. This is changing at every import and I'm trying to find it in the column "AI" of Sheet1. Then I want to copy the columns from "AI" to "AF" from Sheet1 and paste them in Sheet2. What am I doing wrong?
Sub InStrDemo()
Dim lastrow As Long
Dim i As Integer, icount As Integer
Dim LResult As String
LResult = Sheets("Sheet2").Range("A2")
LResult = Left(LResult, 4)
lastrow = Sheets("Sheet1").Range("A30000").End(xlUp).Row
icount = 1
For i = 2 To lastrow
If InStr(1, LCase(Range("AI" & i)), LCase(LResult)) <> 0 Then
icount = icount + 1
Sheets("Sheet2").Range("B" & icount & ":E" & icount) =
Sheets("Sheet1").Range("AF" & i & ":AI" & i).Value
End If
Next i
End Sub
You are trying to copy and paste, after = it should be _ if you are trying to compare. See if it works:
Sheets("Sheet2").Range("B" & icount & ":E" & icount) = _
Sheets("Sheet1").Range("AF" & i & ":AI" & i).Value

How to sum columns without using Loop in VBA

I am trying to reformat a report so it can feed into my system like below:
wbOutput.Sheets(1).Range("B" & O_lrow + 1 & ":B" & O_lrow + lRow).Value = wbSource.Sheets(1).Range("F1:F" & lRow).Value
One issue I encounter is column F needs to be the sum of two source column and below doesn't work:
wbOutput.Sheets(1).Range("F" & O_lrow + 1 & ":F" & O_lrow + lRow).Value = wbSource.Sheets(1).Range("N1:N" & lRow).Value + wbSource.Sheets(1).Range("O1:O" & lRow).Value
I am trying to avoid using loop as there are many rows and I don't want the marco slow down too much.
Is there any simple way to achieve this without using a loop?
You can try this:
wbOutput.Sheets(1).Range("F" & O_lrow + 1 & ":F" & O_lrow + lRow).Value = _
wbSource.Sheets(1).Evaluate("N1:N" & lRow & " + O1:O" & lRow)
This is a way, using the Application.Sum function:
Option Explicit
Sub SumTest()
Dim SumA As Range
Dim SumB As Range
With wbSource.Sheets(1)
Set SumA = .Range("N1:N" & lRow)
Set SumB = .Range("O1:O" & lRow)
End With
wbOutput.Sheets(1).Range("F" & O_lrow + 1 & ":F" & O_lrow + lRow) = Application.Sum(SumA, SumB)
End Sub
You already have two good answers, just want to add my 2 cents here...
If you have lots of data, you should consider using arrays, and one way of doing what you are trying to achieve can be the below, please see comments for further details:
Dim wsOutput As Worksheet: Set wsOutput = wbOutput.Sheets(1) 'allocate the output worksheet to a variable
Dim wsSource As Worksheet: Set wsSource = wbSource.Sheets(1) 'allocate the source worksheet to a variable
Dim arrSource As Variant
Dim arrOutput() As Variant 'Could change this to match your expected data type output
Dim R As Long, C As Long
arrSource = wsSource.Range("N1:O" & lRow) 'Get the source data into an array
ReDim arrOutput(1 To UBound(arrSource), 1 To 1) 'set the size of the output
For R = 1 To UBound(arrSource)
For C = 1 To UBound(arrSource, 2)
arrOutput(R, 1) = arrSource(R, 1) + arrSource(R, 2) 'make your calculations here
Next C
Next R
wsOutput.Range("F" & O_lrow + 1 & ":F" & O_lrow + lRow) = arrOutput 'spit it back to the sheet once is done

Where is the error in my VBA code that read duplicates?

I have an Excel file. In column B row 11 is my product number range up to 100 rows. The code should find duplicate values in the column B. My code is like this:
Dim tgtWB As Workbook
Dim tgtWS As Worksheet
Dim LstRow As Long
LstRow = range("B" & Rows.count).End(xlUp).Row
r = 11
For i = 11 To LstRow
Do until tgWS.Range("B" & i) = "0"
If tgtWS.Range("B" & i) = tgtWS.Range("B" & i+1) Then
msgbox " Duplicate/s found! " & vbCrLf & tgtWS.Range("B" &i).value
exit sub
else
r = r+1
end if
Loop
Next
I just inserted the Do until because the program would stop reading
duplicate values if values in column B are blank or zero(0). And
the code compares only the column B Row 11 and 12.
What am I doing wrong?
Please examine this to see if it can be adapted to your needs:
Sub John()
Dim tgtWS As Worksheet
Dim LstRow As Long
Set tgtWS = ActiveSheet
LstRow = Range("B" & Rows.Count).End(xlUp).Row
For i = 11 To LstRow
If tgtWS.Range("B" & i) = "0" Then Exit Sub
If tgtWS.Range("B" & i) = tgtWS.Range("B" & i + 1) Then
MsgBox " Duplicate/s found! " & vbCrLf & tgtWS.Range("B" & i).Value
Exit Sub
End If
Next i
End Sub
It will find the first set of duplicates (if they are consecutive records) You would need a double loop if the dups are not consecutive

Copying Large Excel Files into 500 row Smaller Files

I have the vba code below in Excel that almost works. I'm having an issue where the "firstrow" isn't increasing. The first file will contain rows 1-501, the second file will contain 1-1001 (I want it to contain row 1 & 502-1001). I'm sure it's a small issue but I've stared at it for a while and can't seem to figure out whats wrong. Some help would be really awesome!!
Sub FiveHundredLineCopy()
Dim Firstrow As Integer
Dim Lastrow As Integer
Dim Copyrange As String
Dim Startcell As String
Dim Month, Year As String
Firstrow = 2 'Starts on row 2 to exclude header
Lastrow = Firstrow + 499
Month = Nov 'Month of Clinic for filename
Year = 2014 'Year of Clinic for filename
Filenumber = 1 'First file in sequence
Let Startcell = "A" & Firstrow
Let Copyrange = "A" & Firstrow & ":" & "BZ" & Lastrow 'Only copying through column BZ
Do While Range(Startcell) <> ""
Range("A1:BZ1", Copyrange).Copy 'Includes A1:BZ1 to copy header row as well
Set NewBook = Workbooks.Add
NewBook.Worksheets("Sheet1").Range("A1").PasteSpecial Paste:=xlPasteAllUsingSourceTheme
NewBook.SaveAs Filename:=Range("AJ2").Text & "_Sams_Apex_" & Month & " " & Year & "_File " & Filenumber & ".csv", FileFormat:=xlCSV
NewBook.Close Savechanges:=False
Firstrow = Firstrow + 500
Lastrow = Firstrow + 499
Filenumber = Filenumber + 1
Let Startcell = "A" & Firstrow
Let Copyrange = "A" & Firstrow & ":" & "BZ" & Lastrow
Loop
End Sub
The Range(Cell1, Cell2) selects the cells starting from Cell1 through Cell2. You can copy and paste the header first and then the Copyrange you want after the fact.
You are extending the Copyrange from the header row to the last row that you want to copy. As mentioned, you could run two operations or hide the rows that have already been copied.
Do While Range(Startcell) <> ""
Range("A1:BZ1", Copyrange).Copy 'Includes A1:BZ1 to copy header row as well
Set NewBook = Workbooks.Add
NewBook.Worksheets("Sheet1").Range("A1").PasteSpecial Paste:=xlPasteAllUsingSourceTheme
NewBook.SaveAs Filename:=Range("AJ2").Text & "_Sams_Apex_" & Month & " " & Year & "_File " & Filenumber & ".csv", FileFormat:=xlCSV
NewBook.Close Savechanges:=False
'hide the ones already copied. hidden rows will not be copied to the new location
copyrange.resize(copyrange.rows.count - 1, copyrange.columns.count).offset(1, 0).entirerow.hidden = true
Firstrow = Firstrow + 500
Lastrow = Firstrow + 499
Filenumber = Filenumber + 1
Let Startcell = "A" & Firstrow
Let Copyrange = "A" & Firstrow & ":" & "BZ" & Lastrow
Loop
Don't forget to unhide all of the rows after the splitting operation has completed.

Show all rows that meet a certain criteria in a pop up window

I am trying to create a pop up that returns either an entire row of data or just the first 3 columns whenever column E is greater than 1. The tricky part is that this has to happen when the "close" button in an another popup that collects data is clicked.
So far I can only get it to return each record in a separate popup by using a loop but I would like to show all cases in the same pop up. Here's what I have:
column A is is Last Name
column B is First Name
column C is a location number
column D is a date
column E is a simple count cell that shows how many times a First and Last Name occur
Private Sub cmdClose_Click()
Dim wsx As Worksheet
Set wsx = Worksheets("SuspectData")
Dim xRow As Long
Dim countingX As Integer
countingX = 2
'find last row in database'
xRow = wsx.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row
'prompt warning'
With wsx
Do While countingX <= xRow
If Range("E" & countingX) > 1 Then
MsgBox ("Suspect " & Range("B" & countingX) & " " & Range("A" & countingX) & " at Unit " & Range("C" & countingX))
End If
countingX = countingX + 1
Loop
End With
Unload Me
End Sub
Thank you!
If you want all cases to return inside of one popup, you should add the cases to a string, and have the popup call the string outside of the loop
Dim s as String
s = ""
Do While countingX <= xRow
If Range("E" & countingX) > 1 Then
s = s & vbnewline & "Suspect " & Range("B" & countingX) & " " & Range("A" & countingX) & " at Unit " & Range("C" & countingX)
End If
countingX = countingX + 1
Loop
MsgBox s

Resources