How to concatenate cells in a row until the first blank cell - vba

I'm currently diving into code/VBA coding for the first time. I have a file that I dump into a worksheet that currently I'm manually organizing and pushing out. When put into the worksheet, it delimits itself across the cells. The first 2-4 cells are always parts of a name. This dump file will have varying row and column lengths every time I get it in a given day and dump into a work sheet. For example, one day it may be twenty rows and one day it may be thirty.
This is a rough illustration of what the data looks like, but my code probably doesn't match with the example below - I just wanted to provide a visual:
So, I'm wanting to make code that will start at A1 and concatenate the cells following it until it runs into a blank cell in that row. Then it places the concatenated data into cell A1 and removes the values it pulled the name pieces from and slides all the data to the left. After that, it continues the same operation on the next row until it meets the final row. As you can see in the image, I don't want any of the data after the blank cell to be affected.
This is my first time programming in general, so when you provide assistance, would you please explain your code so I can learn the concepts? Here's what I think will work so far... I'm just stuck on how to go about concatenating.
The code I currently have:
Sub DN_ERROR_ORGANIZER()
Dim row As Integer
NumRows = Range("A1", Range("A1").End(xldown)).Rows.Count
Range("A1").Select
For row = 1 To NumRows
Do Until IsEmpty(ActiveCell)
' Code to concatenate
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(1, 0).Select
Next
End sub

Here's another way to look at your problem: Suppose you have your table on Sheet2, and the result is reflected on Sheet1.
Sub PutInOrder()
filledcells = 0
'''lastrow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To 100
If Sheet2.Cells(i, 1) = "" Then Exit For
For a = 1 To 4
If Sheet2.Cells(i, a) = "" Then Exit For
If Sheet2.Cells(i, a) <> "" Then
filledcells = filledcells + 1
End If
Next
Select Case filledcells
Case Is = 2
Sheet1.Cells(i, 1) = Sheet2.Cells(i, 1) + ", " + Sheet2.Cells(i, 2)
Sheet1.Cells(i, 3) = Sheet2.Cells(i, 4)
Sheet1.Cells(i, 4) = Sheet2.Cells(i, 5)
Sheet1.Cells(i, 5) = Sheet2.Cells(i, 6)
Sheet1.Cells(i, 6) = Sheet2.Cells(i, 7)
Case Is = 3
Sheet1.Cells(i, 1) = Sheet2.Cells(i, 1) + ", " + Sheet2.Cells(i, 2) + " " + Sheet2.Cells(i, 3)
Sheet1.Cells(i, 3) = Sheet2.Cells(i, 5)
Sheet1.Cells(i, 4) = Sheet2.Cells(i, 6)
Sheet1.Cells(i, 5) = Sheet2.Cells(i, 7)
Sheet1.Cells(i, 6) = Sheet2.Cells(i, 8)
Case Is = 4
Sheet1.Cells(i, 1) = Sheet2.Cells(i, 1) + ", " + Sheet2.Cells(i, 2) + " " + Sheet2.Cells(i, 3) + " " + Sheet2.Cells(i, 4)
Sheet1.Cells(i, 3) = Sheet2.Cells(i, 6)
Sheet1.Cells(i, 4) = Sheet2.Cells(i, 7)
Sheet1.Cells(i, 5) = Sheet2.Cells(i, 8)
Sheet1.Cells(i, 6) = Sheet2.Cells(i, 9)
End Select
filledcells = 0
Next
End Sub

Can you try this and let me know how you get on? It may need some tweaks depending on your precise layout. My approach is slightly different.
Sub x()
Dim n As Long, r1 As Range, r2 As Range, v
For n = 1 To Range("A" & Rows.Count).End(xlUp).Row
On Error Resume Next
Set r1 = Cells(n, 1).EntireRow.SpecialCells(xlCellTypeConstants).Areas(1)
Set r2 = Cells(n, 1).EntireRow.SpecialCells(xlCellTypeConstants).Areas(2)
If Not r1 Is Nothing And Not r2 Is Nothing Then
v = Join(Application.Transpose(Application.Transpose(r1)), ", ")
Cells(n, 1) = WorksheetFunction.Proper(v)
Cells(n, 2).Resize(, r1.Count).Clear
r2.Cut Cells(n, 3)
End If
Next n
End Sub

Related

button different from Module?

Private Sub CommandButton1_Click()
Dim nbp As Long
Dim i As Long
Dim p As Long
Dim FV As Variant
Dim CS As Variant
Dim K As Variant
Dim iFV As Integer
Dim iCS As Double
If Range("B9") = "Semi-Annual" Then
p = DateDiff("yyyy", Cells(4, 3), Cells(5, 3))
nbp = p * 2
For i = 5 To nbp + 4
Cells(5, 10).Value = Cells(4, 3).Value
Cells(i + 1, 10).Value = DateAdd("m", 6, Cells(i, 10).Value)
Next i
For i = 6 To nbp + 5
Cells(i, 14).Value = Cells(7, 2).Value * (Cells(8, 2).Value / 2)
Next i
FV = Sheet2.Range("J5:J10").Value
CS = Sheet3.Range("F1:G8000").Value
For iFV = 1 To UBound(FV)
For iCS = 1 To UBound(CS, 2)
If FV(iFV, 1) = CS(iCS, 1) Then
K(iFV, 1) = CS(iCS, 2)
End If
Next
Next
Sheet2.Range("K5:K10").Value = K
End If
End If
If Range("B9") = "Annual" Then
nbp = DateDiff("yyyy", Cells(4, 3), Cells(5, 3))
For i = 5 To nbp + 4
Cells(5, 10).Value = Cells(4, 3).Value
Cells(i + 1, 10).Value = DateAdd("m", 12, Cells(i, 10).Value)
Next i
End if
If Range("B9") = "Quarterly" Then
p = DateDiff("yyyy", Cells(4, 3), Cells(5, 3))
nbp = p * 4
For i = 5 To nbp + 4
Cells(5, 10).Value = Cells(4, 3).Value
Cells(i + 1, 10).Value = DateAdd("m", 3, Cells(i, 10).Value)
Next i
End If
If Range("B9") = "Monthly" Then ' to choose from a list .
p = DateDiff("yyyy", Cells(4, 3), Cells(5, 3))
nbp = p * 12
For i = 5 To nbp + 4
Cells(5, 10).Value = Cells(4, 3).Value
Cells(i + 1, 10).Value = DateAdd("m", 3, Cells(i, 10).Value)
Next i
End If
End Sub
I have added all the code in the button to help. i am not sure if that will help, anyway here is it. if the user chooses semi annual then couple of things take place. Same goes for the rest "ifs" but i need to fix this issue first then move on to the rest. the code to too long, it is simple and not complicated.
Now that more of the code is posted, I think I understand what the problem is.
Wherever you reference Cells() VBA assumes it applies to ActiveSheet. And I think you should fully qualify the calls to be Sheet2.Cells() for example or whatever you need.
When you call the code behind a button, the button resides on a sheet and it references the cells on that sheet. But when you moved the code to a module it no longer referenced the sheet with the button, but whatever other sheet was active at the time.
So whenever you see Cells() or Range() without a worksheet specification in front of it, change it so that it you target a specific worksheet.
PS. Avoid using Integer and prefer Long instead. Also, prefer relative referencing such as Sheet2.Range("G2").Cells(i,j) instead of absolute referencing Sheet2.Cells(1+i, 6+j) or string math such as Sheet2.Range("G" & 1+i & ":G" & 5+i).

Excel VBA: Opening Workbooks and Copying Cells

The macro below opens a series of workbooks from a list, then copies some data from them. It works fine for the first workbook, then crashes on the second. I've tried changing the order, and it's always the second workbook that causes it to crash.
Sub ImportData()
Dim lastRow As Long
Dim lastSumRow As Long
Dim j As Long
Dim k As Long
With ActiveSheet
lastRow = ActiveSheet.Cells(1048576, 1).End(xlUp).Row
End With
For k = 2 To lastRow
k = 2
lastUsedRow = ThisWorkbook.Sheets("Summary").Cells(1048576, 1).End(xlUp).Row
If ActiveSheet.Cells(k, 2).Value <> "Imported" Then
Workbooks.Open Filename:=ThisWorkbook.Path & "\Analysis\" & Cells(k, 1), UpdateLinks:=False
ActiveWorkbook.Sheets("Summary").Activate
For j = 3 To 100
If j Mod 3 = 0 Then
ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 1).Value = ActiveWorkbook.Sheets("Summary").Cells(j, 1).Value
ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 2).Value = ActiveWorkbook.Sheets("Summary").Cells(j + 1, 2).Value
ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 3).Value = ActiveWorkbook.Sheets("Summary").Cells(j + 1, 3).Value
ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 4).Value = ActiveWorkbook.Sheets("Summary").Cells(j + 1, 4).Value
ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 5).Value = ActiveWorkbook.Sheets("Summary").Cells(j + 2, 2).Value
ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 6).Value = ActiveWorkbook.Sheets("Summary").Cells(j + 2, 3).Value
ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 7).Value = ActiveWorkbook.Sheets("Summary").Cells(j + 2, 4).Value
ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 8).Value = ActiveWorkbook.Sheets("Summary").Cells(j + 1, 5).Value
End If
Next j
ActiveWorkbook.Close
End If
ThisWorkbook.Sheets("Setup").Cells(k, 2).Value = "Imported"
Next k
End Sub
I'm guessing your error is here:
Workbooks.Open Filename:=ThisWorkbook.Path & "\Analysis\" & Cells(k, 1), UpdateLinks:=False
'Ooops ^^^^^
The .Activate and .Select calls are convoluted enough that I'm not really going to expend the effort figuring out what should be the active worksheet at that particular point in your code on the second run through the loop. Whatever it is, it's different than it was when you started and an unqualified call to Cells implicitly refers to whatever worksheet is the ActiveSheet at the time. This builds a bad file name (or fails completely) and then the wheels come off.
The best thing to do is not use the Active* objects at all. Get references to the objects that you're using, and well, use them. That way there is no chance that you'll get wires crossed. While you're at it, you can give them names that make it obvious what you're working with at a glance.
Couple other things before we get to the code that doesn't use Activate and Select.
lastSumRow is never used and lastUsedRow is never declared. I'm assuming they were supposed to be the same thing. You should put Option Explicit at the top of your modules to avoid this type of error (and worse ones).
These 2 lines of code make very little sense together:
For j = 3 To 100
If j Mod 3 = 0 Then
If you only want to copy every 3rd row, skip all the division and just increment your loop counter with a Step of 3:
For j = 3 To 99 Step 3
Note that you can stop at 99, because 100 Mod 3 is never going to be 0.
Your With block here isn't using the captured reference...
With ActiveSheet
lastRow = ActiveSheet.Cells(1048576, 1).End(xlUp).Row
End With
...but you continually use this pattern that would be useful in a With block:
ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 1).Value = ...
ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 2).Value = ...
ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 3).Value = ...
Hard-coding Cells(1048576, 1) will fail on older versions of Excel. You should use Rows.Count instead.
As mentioned in the comments, k = 2 creates an infinite loop.
You don't need to repeatedly find the last row of the sheet you're copying to with this code:
lastUsedRow = ThisWorkbook.Sheets("Summary").Cells(1048576, 1).End(xlUp).Row
Each time you go through your "j" loop, the last row increases by one. Just add 1 to lastUsedRow instead of doing all the row counting gymnastics.
If you're working with Worksheets, use the Worksheets collection instead of the Sheets collection:
ThisWorkbook.Sheets("Summary") '<--I could return a Chart!
Put all of that together, and you come up with something like the code below. Note that I have no clue what the ActiveSheet is supposed to be when you start this macro, so I just named the variable it's stored in active. It's quite possible that it's one of the other worksheets it grabs a reference too (I have no clue) - if so, you should consolidate them into one reference:
Public Sub ImportData()
Dim lastRow As Long
Dim lastUsedRow As Long
Dim dataRow As Long
Dim fileNameRow As Long
Dim active As Worksheet
Set active = ActiveSheet
With active
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
Dim setupSheet As Worksheet
Set setupSheet = ThisWorkbook.Worksheets("Setup")
With ThisWorkbook.Worksheets("Summary")
lastUsedRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For fileNameRow = 2 To lastRow
If active.Cells(fileNameRow, 2).Value <> "Imported" Then
Dim source As Workbook
Set source = Workbooks.Open(ThisWorkbook.Path & "\Analysis\" & _
active.Cells(fileNameRow, 1), False)
Dim dataSheet As Worksheet
Set dataSheet = source.Worksheets("Summary")
For dataRow = 3 To 99 Step 3
.Cells(lastUsedRow, 1).Value = dataSheet.Cells(dataRow, 1).Value
.Cells(lastUsedRow, 2).Value = dataSheet.Cells(dataRow + 1, 2).Value
.Cells(lastUsedRow, 3).Value = dataSheet.Cells(dataRow + 1, 3).Value
.Cells(lastUsedRow, 4).Value = dataSheet.Cells(dataRow + 1, 4).Value
.Cells(lastUsedRow, 5).Value = dataSheet.Cells(dataRow + 2, 2).Value
.Cells(lastUsedRow, 6).Value = dataSheet.Cells(dataRow + 2, 3).Value
.Cells(lastUsedRow, 7).Value = dataSheet.Cells(dataRow + 2, 4).Value
.Cells(lastUsedRow, 8).Value = dataSheet.Cells(dataRow + 1, 5).Value
lastUsedRow = lastUsedRow + 1
Next
source.Close
End If
setupSheet.Cells(fileNameRow, 2).Value = "Imported"
Next
End With
End Sub

Automatically update sheet 2 & sheet 3 from sheet 1 as per data

I want to automatically update sheet 2 & sheet 3 from sheet 1 as per data. It will be helpful if it gets resolved.
I am new to visual basic coding so unaware of its script but aware of c++. Whatever the solution may be it will be helpful.
Screen shot of the three sheets - I was unable to upload the Excel files
I have tried the following code:
Sub FindMatches()
Dim oldrow As Integer
Dim newrow As Integer
For oldrow = 4 To 14
For newrow = 3 To 20
If Cells(oldrow, 12) = Cells(1, newrow) And Cells(oldrow, 13) = Cells(newrow, 1) Then 'date and brand
If Cells(1, 14) = Cells(newrow, 2) Then
Cells(newrow, 3).Value = Cells(oldrow, 14).Value ' m1
End If
If Cells(1, 15) = Cells(newrow + 1, 2) Then
Cells(newrow + 1, 3).Value = Cells(oldrow, 15).Value ' m2
End If
If Cells(1, 16) = Cells(newrow + 2, 2) Then
Cells(newrow + 2, 3).Value = Cells(oldrow, 16).Value ' m3
End If
If Cells(1, 17) = Cells(newrow + 3, 2) Then
Cells(newrow + 3, 3).Value = Cells(oldrow, 17).Value ' issue
End If
If Cells(1, 18) = Cells(newrow + 4, 2) Then
Cells(newrow + 4, 3).Value = Cells(oldrow, 18).Value ' repack
End If
If Cells(1, 19) = Cells(newrow + 5, 2) Then
Cells(newrow + 5, 3).Value = Cells(oldrow, 19).Value ' extra
End If
If Cells(1, 20) = Cells(newrow + 6, 2) Then
Cells(newrow + 6, 3).Value = Cells(oldrow, 20).Value ' wastage
End If
End If
Next newrow
Next oldrow
End Sub
Maybe you even don't need VBA to update the data. You can simply enter a formula =C2 into a cell to reference (and retrieve the data from) a cell.
You also can reference cells from other sheets like this =Sheet1!C2.
And you can use Functions such as IF to do more complex cases and logic.
You just cant use Cells without sheet referencing. Because excel dont know which sheet you wana to use and assuming active sheet. So you need to you ActiveSheet.cells() and switching active sheet (but its not highly recommended). Instead use sheet declaration like this
Dim myLovelySheet as worksheet
Set mylovelySheet = Sheets("yourCuteSheetname")
and then you can work with sheet like with object (you will be familiar to it from C++)
myLovelySheet.cells()
or you can perform multiple operations on sheet with construction like this
with myLovelySheet
.cells()
.cells()
'etc
end with
Basicaly your approach is almost correct, but try study more code. I can recommend this which have multiple examples with good practise

Merge text from two cells in Excel into one with VBA

I received many Excel files from a client.
Their system extracted the data into a spreadsheet, but one column is having issues. If the text was too long, it would put the remaining text into the cell below it.
This causes all the other fields in that row to be blank, except for the overflow.
How can I merge cells at issue into one for all files I received?
I uploaded a screen shot of the file as an example. Notice on row 8 that H8 is the only cell. That needs to be merged with H7. Not every row is at issue though.
asuming A is the main (and empty for doubles)
asuming H holds the text
then in L1 and copy down
=H1&IF(LEN(A2),H2,"")
simplest way (then copy values from L to H and delete empty lines (simply with filter)
when having unknown number of lines (after splitting) you better use vba (or simply repeat the whole procedure till there no empty lines anymore...
doing it in VBA:
Sub testing()
Dim i As Long
While Len(Cells(i + 1, 8))
i = i + 1
While Len(Cells(i + 1, 1)) = 0 And Len(Cells(i + 1, 8))
Cells(i, 8) = Cells(i, 8) & Cells(i + 1, 8)
Rows(i + 1).Delete
Wend
Wend
End Sub
most programs skip spaces so you may want to use:
=H1&IF(LEN(A2)," "&H2,"")
or for vba change Cells(i, 8) = Cells(i, 8) & Cells(i + 1, 8) to Cells(i, 8) = Cells(i, 8) & " " & Cells(i + 1, 8)
This will concatenate the texts in H and delete the row that is not useful :
Sub test_bm11()
Dim wS As Worksheet, _
LastRow As Long, _
i As Long
Set wS = ActiveSheet
With wS
LastRow = .Range("H" & .Rows.Count).End(xlUp).Row
For i = LastRow To 2 Step -1
If .Cells(i, "A") <> vbNullString Then
Else
.Cells(i, "H").Offset(-1, 0) = .Cells(i, "H").Offset(-1, 0) & .Cells(i, "H")
.Cells(i, "H").EntireRow.Delete
End If
Next i
End With
End Sub

excel VBA find duplicate entries in worksheets

My code :
For i = 1 To iRowNumber
If Cells(i, x).Value > 1 Then
Cells(i, 2).Copy
Sheets(1).Select
Cells(1, 1).Value = Now
Cells(1, 2).Value = "Duplicate"
Cells(1, 4).Select
ActiveSheet.Paste
Cells(1, 3).Value = Mid(Cells(1, 4), 5, 4)
End If
Next i
x=x+1
Condition :
sheet(2) > 130916001, 130916001000009, 1 '~> check if 3rd column more than 1
expected result :
sheet(1) first row > time , "duplicate", 1600 , 130916001000009
sheet(2) 130916001, 130916001000009, 2 '~> change 1 become 2
result :
sheet(1) fine
sheet(2) 130916001, 130916001000009, not2 '~> error
If i extract this part of code, the counter works fine
Fyi i have 6 sheets, but dunno because of this or not?
Keeping #nutsch suggestions in mind, here is some code with qualified cells, so there's no confusion about which cells belong to which sheet. I'm not exactly sure what you're trying to accomplish, but should be easy enough to make appropriate changes.
Sub copyData()
Dim i As Long, x As Long, iRowNumber As Long
For i = 1 To iRowNumber
If Sheet2.Cells(i, 3) = 1 Then
With Sheet1
.Cells(i, 1).Value = Now() 'time
.Cells(i, 2).Value = "Duplicate"
.Cells(i, 3).Value = Mid(Sheet2.Cells(i, 2), 5, 4)
.Cells(i, 4).Value = Sheet2.Cells(i, 2).Value
End With
Sheet2.Cells(i, 3).Value = 2
End If
Next i
End Sub