I want to copy all rows that have a specific value in column E and then insert them (NOT PASTE! so i want to insert new rows start at cell A29) on another sheet.
The sheet I want to copy from is called "owssvr" and the one I want to copy to is called "AOB Approval Form". I want to insert the copied rows starting Cell A29 in the "AOB Approval Form".
When i run the code, nothing happens. No error message pops up.
Few definition of my code below:
LastRow: The last row of the "owssvr" sheet
PrimaryAOB: value that i want to lookup for in column 5. It is on the "AOB Approval Form" sheet
Here is my code:
For k = 2 To lastRow
If Worksheets("owssvr").Range("E" & k).Value = primaryAOB Then
Worksheets("owssvr").Rows(k).Copy
Worksheets("AOB Approval Form").Rows(k + 27).Insert Shift:=xlDown
Application.CutCopyMode = False
End If
Next k
THANK YOU!
I copied your code into a new module in a blank workbook, then made the necessary mods to make it run (which it did). It looks the same as yours:
Sub Question()
Dim k As long, lastRow As Long
Dim primaryAOB As String
lastRow = Sheets(1).Range("E" & (ActiveSheet.Rows.Count)).End(xlUp).Row
primaryAOB = Sheets(2).Range("A1").Text
For k = 2 To lastRow
If Worksheets("owssvr").Range("E" & k).Value = primaryAOB Then
Worksheets("owssvr").Rows(k).Copy
Worksheets("AOB Approval Form").Rows(k + 27).Insert Shift:=xlDown
Application.CutCopyMode = False
End If
Next k
End Sub
Since this worked, you may have just had some little syntax error somewhere while defining the variables. show us more of your procedure, that may reveal the issue! Also, have you run your code line by line? (F8)
I would like to copy the contents in A1:AV1 only if B2:BV2 is populated. I want to copy blank without ending up pasting tab or spaces in blank cells. As a step two I need to copy B2:BV2 to row C eliminating any blank cell. Step three I need to take those entries from row C so that only 4 entries populate the following rows D through the end (no more than 10 rows).
I came up with the following with only a partial paste (the best I could do).
Sub Copy()
If IsEmpty(Range("A2").Value) = False Then
ActiveSheet.Range("A1").Copy Range("A3")
End If
If IsEmpty(Range("B2").Value) = False Then
ActiveSheet.Range("B1").Copy Range("B3")
End If
If IsEmpty(Range("C2").Value) = False Then
ActiveSheet.Range("C1").Copy Range("C3")
End If
If IsEmpty(Range("D2").Value) = False Then
ActiveSheet.Range("D1").Copy Range("D3")
End If
If IsEmpty(Range("E2").Value) = False Then
ActiveSheet.Range("E1").Copy Range("E3")
End If
Sheet1.Range("a3:Y3").SpecialCells(xlCellTypeConstants).Copy ActiveSheet.Range("A4")
End Sub
This worked until AO after that it broke down and did not copy the correct cells. I know this should be done is come type of an array, but I couldn't figure out the loop.
First make better a loop for cell check and copy like this that will include all conditions you want:
PS. i mean the logic in the code not just a code i wrote:
For I = 1 To Sheet1.Columns.Count
If Sheet1.Cells(1, I).Value <> "" and not IsNull(Sheet1.Cells(1, I).Value) Then
I2=I2+1
Sheet1.Cells(2, I2).Value=Sheet1.Cells(1, I).Value
End if
If Sheet1.Cells(2, I2).Value <> "" and not IsNull(Sheet1.Cells(2, I2).Value) Then
I3=I3+1
Sheet1.Cells(3, I3).Value=Sheet1.Cells(1, I2-1).Value
End if
after this point i think you can move forward. otherwise write what you face.
I'm new to the community and I apologize if there is a thread elsewhere, but I could not find it!
I'm currently diving into 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. 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.
A certain roadblock in my VBA code creation process has presented itself. I'm trying to create a code that will parse through the worksheet to remove any time a certain value appears (See below image - I'm referring to the (EXT)). After doing so I'm trying to concatenate the cells in the row up until there is a space (which with the rows that have (EXT), there usually isn't a space after until the (EXT) is removed).
The code I made works for now but I recognize it's not very efficient and not reliable if the names extend longer than two cells. I was hoping someone on here could provide me with guidance. So, I'm looking for two things:
For the code to scan the whole active used range of the table and remove (EXT). As it may appear in various columns.
A way to concatenate the cells in every row in the active range from A to the cell before a blank cell
Keep in mind I have no coding background, I'm learning and I'm not familiar with VBA terms and whatnot all that much just yet - so if you could please explain in laymen's terms I'd appreciate it. I hope all of this makes sense... Thanks in advance!
This is just an example of part of what the dump code looks like, so my code probably doesn't match with the example below - I just wanted to provide a visual:
http://i.imgur.com/IwDDoYd.jpg
The code I currently have:
Sub DN_ERROR_ORGANIZER()
' Removes any (EXT) in Column 3 in actual dump data file
For i = 200 To 1 Step -1
If (Cells(i, 3).value = "(EXT)") Then
Cells(i, 3).Delete Shift:=xlToLeft
End If
Next i
' Removes any (EXT) in Column 4 in actual dump data file
For j = 200 To 1 Step -1
If (Cells(j, 4).value = "(EXT)") Then
Cells(j, 4).Delete Shift:=xlToLeft
End If
Next j
' Removes any (EXT) in Column 5 in actual dump data file
For k = 200 To 1 Step -1
If (Cells(k, 5).value = "(EXT)") Then
Cells(k, 5).Delete Shift:=xlToLeft
End If
Next k
' Places a new column before A and performs a concatenate on cells B1 and C1 to
' form a name, then copies all through column A1 to repeat on each row
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "=PROPER(CONCATENATE(RC[1],"", "", RC[2]))"
Range("A1").Select
Selection.AutoFill Destination:=Range("A1:A51")
Range("A1:A51").Select
End Sub
edited: to keep the comma after the first "name" only
this should do:
Sub main()
Dim cell As Range
With Worksheets("names")
With Intersect(.UsedRange, .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).EntireRow)
For Each cell In .Rows
cell.Cells(1, 2).Value = Replace(Replace(Replace(Join(Application.Transpose(Application.Transpose(cell.Value)), " "), " ", " "), " (EXT)", ""), " ", ", ", , 1)
Next cell
.Columns(1).FormulaR1C1 = "=PROPER(RC[1])"
.Columns(1).Value = .Columns(1).Value
.Offset(, 1).Resize(, .Columns.Count - 1).ClearContents
End With
End With
End Sub
just remember to change "names" to you actual worksheet name
edited 2:
code for stopping cells to be processed at every line at the last one before the first blank one
Sub main()
Dim cell As Range, dataRng As Range
With Worksheets("names") '<--| change "names" to you actual worksheet name
Set dataRng = Intersect(.UsedRange, .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).EntireRow)
For Each cell In dataRng.Columns(1).Cells
cell.Offset(, 1).Value = Replace(Replace(Replace(Join(Application.Transpose(Application.Transpose(.Range(cell, cell.End(xlToRight)).Value)), " "), " ", " "), " (EXT)", ""), " ", ", ", , 1)
Next cell
With dataRng
.Columns(1).FormulaR1C1 = "=PROPER(RC[1])"
.Columns(1).Value = .Columns(1).Value
.Offset(, 1).Resize(, .Columns.Count - 1).ClearContents
End With
End With
End Sub
I believe you are quite close to achieve what you are asking for and, based on your request, I will not give you a solution but some guidance to complete it by yourself.
First 3 loops: You could simplify by having a single set of nested loops: An outer loop running from 3 to 5, an inner loop running from 200 to 1; the outer loop will run over index, say "p", the inner over index, say "q", and your reference to cells would become Cells(q,p). If you need to run this over more than 3 rows, just start the outer loop from, say, 3 and till, say 10000 (being 10000 the maximal number of rows your data may display) and add a condition that if the first cell of the row is empty, you exit the outer loop.
The second part (this is what I understood) is to take the 2-3 first cells and concatenate them into a new cell (i.e. the column you add at the left). Once again, you can just loop over all your rows (much the same as in the outer loop mentioned above), except that now you will be looking at the cells in columns 2-4 (because you added a column at the left). The same exit condition as above can be used.
I'm not sure if this is what you were looking for, but this is what I understood you were looking for.
After reading user3598756's answer, I realized that I missed the boat with my original answer.
Sub DN_ERROR_ORGANIZER()
Dim Target As Range
Set Target = Worksheets("Sheet1").UsedRange
Target.Replace "(EXT)", ""
With Target.Offset(0, Target.Columns.Count).Resize(, 1)
.FormulaR1C1 = "=PROPER(C1&"", ""&TEXTJOIN("" "",TRUE,RC[-" & (Target.Columns.Count - 1) & "]:RC[-1]))"
.Value = .Value
End With
Target.Delete
End Sub
UPDATE
If you are running an older version of Excel that doesn't support TEXTJOIN then use this:
Sub DN_ERROR_ORGANIZER()
Dim Data
Dim x As Long, y As Long
Dim Target As Range
Dim Text As String
Set Target = Worksheets("Sheet1").UsedRange
Target.Replace "(EXT)", ""
Data = Target.Value
For x = 1 To Target.Rows.Count
Data(x, 1) = Data(x, 1)
For y = 2 To Target.Columns.Count
If Data(x, y) <> vbNullString Then Text = Text & " " & Data(x, y)
Next
If Len(Text) Then Data(x, 1) = Data(x, 1) & "," & Text
Text = vbNullString
Next
Target.ClearContents
Target.Columns(1).Value = Data
End Sub
This question already has answers here:
How to "flatten" or "collapse" a 2D Excel table into 1D?
(9 answers)
Closed 6 years ago.
Currently I have a data-set of 4000 rows with data arranged below:
The format it needs to be in is like this:
I have ignored the dates field or the X,Y,Z fields at the moment and just want to focus on the rows. I'm new to VBA still so please bear with my explanations.
My understanding of this is that I should use a variant to store the data as 1-dimensional arrays and then cycle through this via a for-loop.
This is what my code attempts to do (albeit clumsily):
Sub TransposeData()
Dim Last As Variant
Application.ScreenUpdating = False
prevCalcMode = Application.Calculation
Application.Calculation = xlCalculationManual
Last = Cells(Rows.Count, "L").End(xlUp).Row
'Go to the very bottom of row L and get the count
'For i = row Count - 1 from this and check what the value of L is
'If the value of L is greater than 0 Then ...
For i = Last To 1 Step -1
If (Cells(i, "L").Value) > 0 Then
range("D" & i & ":L" & i).Copy
Sheets("test").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Sheets("CVM").Select
End If
Next i
Application.Calculation = prevCalcMode
Application.ScreenUpdating = True
End Sub
However I am stuck at setting my 'range' variable as I don't know how to make it specific to each iteration. i.e. Range(i,L) This will not work obviously but I can't seem to think of another way around this.
Could you please point me in the right direction? I did look at a few other VBA questions regarding this but I couldn't apply the same methodology to my issue.
(Transpose a range in VBA)
Thank you!
EDIT: I now have my macro starting to work (yay!), but the loop keeps over-writing the data. Is there a way to check where the data was last pasted and make sure you paste in the next blank part of the column?
Seeing as you are new to VBA, as you said.
A few things:
Always use indexed based reference, like you used for range("D" & i & ":L" & i).Copy but then you did not use it for the PasteSpecial
Make sure you use referencing to the specific sheet you are wanting to operate out of, this way VBA doesnt need to assume anything
Try use descriptive variables this helps the next user really understand your code.
Also Use Option Explicit ALWAYS, I did no like it in the beginning but once I was used to typing correct variables for everything, like we should, its not an issue anymore. To have the Option Explicit on every module just go
Tool >> Options >> Require Variable Declaration
See answer below
Option Explicit
Sub TransposeData()
Application.ScreenUpdating = False
Dim PrevCalcMode As Variant
PrevCalcMode = Application.Calculation
Application.Calculation = xlCalculationManual
Dim DataSheet As Worksheet
Set DataSheet = ThisWorkbook.Sheets("CVM")
Dim DestinationSheet As Worksheet
Set DestinationSheet = ThisWorkbook.Sheets("test")
Dim DataSheetLastCell As Variant
With DataSheet
DataSheetLastCell = .Cells(.Rows.Count, "L").End(xlUp).Row
End With
Dim DataSheetRowRef As Long
Dim DestinationSheetNextFreeRow As Long
For DataSheetRowRef = 2 To DataSheetLastCell
If Not DataSheet.Cells(DataSheetRowRef, "L") = Empty Then
DataSheet.Range("D" & DataSheetRowRef & ":L" & DataSheetRowRef).Copy
With DestinationSheet
DestinationSheetNextFreeRow = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
.Cells(DestinationSheetNextFreeRow, "B").PasteSpecial Transpose:=True
End With
End If
Next DataSheetRowRef
Application.ScreenUpdating = True
PrevCalcMode = Application.Calculation
End Sub
I am trying to delete specific rows from an excel sheet, if the data contained in a specific cell are different from their neighbors
The sheet is already sorted, as a result I can have this comparison.
The issue here is that, although a sheet around 3,000 lines would take less than a minute, when this escalates to 60,000 the function seems to never end.
Is there something wrong in what I am trying?
Is there a more efficient way?
Private Function DeleteSingleItemLines() As Long
Dim lastRow As Long
With ActiveSheet
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
lastRow = lastRow - 2
For rwIndex = 6 To lastRow
If Cells(rwIndex, "B").Value <> Cells(rwIndex + 1, "B").Value _
And Cells(rwIndex, "B").Value <> Cells(rwIndex - 1, "B").Value Then
Rows(rwIndex & ":" & rwIndex).Delete Shift:=xlUp
lastRow = lastRow - 1
rwIndex = rwIndex - 1
End If
Next rwIndex
DeleteSingleItemLines = lastRow
End Function
Well, first of all, with very small changes in your code you can make it faster by setting the property ScreenUpdating to false (write this code right after declaring variables) as in:
Application.ScreenUpdating = False
The code above keeps Excel without rendering changes in the screen and makes processing a lot faster.
Thinking about your problem in another way, you could put a formula inside your worksheet returning TRUE or FALSE for the condition you have and then use a AutoFilter to delete them all at once. It is possible to do that in vba code also.
Best regards,
Abe