Copying columns including blanks without skipping rows..leave "blanks" blank VBA - vba

Aplication Defined error Copying a specified column and range including blanks with an embedded button running multiple Macros. I know that all rows will be filled in column A so if I could reference the rest of the Macros to A.end
I've looked Google youtube and here although there is a lot of info on copying and pasting, I cannot find one that works for this running multiple Macros.
Macros 5 & 6 is where I start having problems because these columns have multiple blanks throughout.
Raw data to Copy:
Destination:
Private Sub CommandButton1_Click()
Worksheets("Sheet1").Range("a2", Range("a2").End(xlDown)).Copy _
Worksheets("Sheet2").Range("a2") 'macro1
Worksheets("Sheet1").Range("d2", Range("d2").End(xlDown)).Copy _
Worksheets("Sheet2").Range("b2") 'Macro2
Worksheets("Sheet1").Range("c2", Range("c2").End(xlDown)).Copy _
Worksheets("Sheet2").Range("c2") 'macro3
Worksheets("Sheet1").Range("g2", Range("g2").End(xlDown)).Copy _
Worksheets("Sheet2").Range("d2") 'macro4
If Worksheets("Sheet1").Range("e2", Range("e2").End(xlDown)).Value = "<0" Then
Worksheets("Sheet2").Range("i2").Copy 'macro5
If Worksheets("Sheet1").Range("e2", Range("e2").End(xlDown)).Value = ">0" Then
Worksheets("Sheet2").Range("j2").Copy 'macro6
Worksheets("Sheet2").Activate 'macro7

Range.end(xldown) only gets you a contiguous range (effectively it will stop at the first blank cell).
Since you want to include blanks, you might want to instead work from the last row of your worksheet back up to the first non-blank cell encountered in that column (which is a way of getting the last row).
This would mean something like:
' If you are new to With statements (below), any objects within the With block that begin with a . relate to "Sheet1". Saves us typing Sheet1 repeatedly, and makes sense to use it since we access a lot of Sheet1's members like range/cells/rows
With Worksheets("Sheet1")
.Range("a2", .cells(.rows.count, "A").End(xlup)).Copy Worksheets("Sheet2").Range("a2") 'macro1
End with
Untested, written on mobile -- but hope it works or gets you closer to a solution. You would need to copy-paste the above and change the A to B, C, D, E, etc. I wasn't too sure what you're trying to achieve with the "<0" condition in macro 5 and 6.
(It would better if you turned the code into a parameterised Sub and just provide the column letter/number as an argument to the sub, but just depends how new you are to VBA and programming in general -- and for the time being whatever is easier for you to understand/maintain.)
Edit regarding macro 5 and 6
With Worksheets("Sheet1")
Dim cell as range
For each cell in .Range("E2", .Cells(.Rows.Count, "E").End(xlUp))
If cell.Value <= 0 Then 'Get rid of the equal sign if you don't want it in your logic/condition'
Cell.Copy Worksheets("Sheet2").cells(cell.row, "I") 'Macro5
ElseIf cell.value > 0 Then
Cell.Copy Worksheets("Sheet2").cells(cell.row, "J") 'Macro6
End If
Next cell
End With
Worksheets("Sheet2").Activate 'macro7

Related

Compare Cell Data and Copy

I found this great snip of code and I am trying to manipulate it to work for me, but I just can't seem to get it. Unfortunately I haven't been able to get my head around it to fully understand it, which doesn't help. So I turn to you. I need to evaluate a column of cells and look for either similarities or differences. If a cell in sheet 1 column 1 is not the same as any of the cells in sheet 2 column 1, I want to copy the entire row into sheet 1 at the bottom of the used area. I've gotten this to the point where what you see will copy the correct first cell, but I can't manipulate it to copy the entire row. I think because of how the 'With' is structured but I need to try to stay away from doing loops since there is over 30k cells to evaluate.
Going down the road I will also be wanting to look for duplicates using the same method above, and if there is a duplicate, compare the adjacent cells for differences and if there is a difference, move the existing data into a comment and move the new data into the existing cell.
Any and all advice is, as always, very appreciated.
Sub Compare_Function()
Call Get_Master_Cell_Info
Application.ScreenUpdating = False
With Sheets("Update").Range(Cells(4, 1), Cells(Rows.Count, 1).End(xlUp)).Offset(, 1)
.Formula = "=VLOOKUP(A4,'New Master Data 6.1'!A:A,1,FALSE)"
.Value = .Value
.SpecialCells(xlCellTypeConstants, 16).Offset(, -1).Copy Sheets("New Master Data 6.1").Range("A" & Rows.Count).End(xlUp).Offset(1)
.ClearContents
End With
Application.ScreenUpdating = True
End Sub
Quick line by line breakdown
This just takes the entire used range from cells A4 to the last used cell in columnA then offsets it by one column so B4:Bx (x is the last used row in column A)
With Sheets("Update").Range(Cells(4, 1), Cells(Rows.Count, 1).End(xlUp)).Offset(, 1)
This puts the formula in all cells so it looks up A4,A5,A6, etc in master sheet, returns the value in the master sheet or an error if its not found. It then copies the values over so they are hardcoded in
.Formula = "=VLOOKUP(A4,'New Master Data 6.1'!A:A,1,FALSE)"
.Value = .Value
Specialcells looks for constants (all cells) and value 16 which means error cells (ie cells don't exist) offsets by -1 (so column A) and copies to new sheet column A at rows.count+1
.SpecialCells(xlCellTypeConstants, 16).Offset(, -1).Copy Sheets("New Master Data 6.1").Range("A" & Rows.Count).End(xlUp).Offset(1)
You might also want to do this after you .clearcontents so you don't get all the error cells in column B
to fix it just change the copied range to .entirerow so
.SpecialCells(xlCellTypeConstants, 16).entirerow.Copy Sheets("New Master Data 6.1").Range("A" & Rows.Count).End(xlUp).Offset(1)
You will also copy the errors in column B but with this structure there is no getting around that. Can always erase them from the master sheet after.
Also note this code will overwrite any data you have stored in column B.
One more note this code depends on the sheet update being active, it won't run otherwise since your cells function inside your range needs the worksheet explicitly stated, as does your rows.count. You would be better wrapping the whole thing in 2 withs, one for the sheet and one with the range (using .cells and .rows.counmt)

Move whole row based on column A to offset(-1,4)

I currently have a large Excel file where the data doesn't line up with the corresponding headers.
In order to fix this I need to cut and paste all of the rows where column "A" contains "Planned" up one row and four columns to the right. I have a few thousand rows that need to be moved (with VBA). I have been working on piecing together some code but with no avail (I have limited knowledge of VBA).
The below shows a snapshot of the data I am working with. I need the yellow row to be moved to the red area. The green row on top is an example of what it looks like after manually making the change. Hopefully this code would loop through the whole sheet give me data that lines up with their respectful headers.
(the row of yellow data that needs to be moved is 60 columns wide by the way, the picture only shows a small snapshot of the worksheet)
Quick & dirty, untested solution. Give it a go.
Dim cel as range
For each cel in Range("A1:A" & Range("A1").end(xldown).row
if cel.value = "Planned:" then
cel.resize(1,60).cut
cel.offset(-1,4).pastespecial xlpasteall
end if
next cel
You can try this method (without VBA)
select the destination region (red region)
hit Ctrl+g then click the Special button
choose Blank, click Ok
type in the reference formula (e.g. in E3 the formula be =A4) and hit Ctrl+Enter to fill all
copy paste the entire red column as value (i.e. remove the formula)
filter column A for value Planned: and delete the rows.
I know this has a drawback, on step 6 if your data is VERY LARGE, Excel might fail to delete filtered rows properly
This short procedure should take care of the aberrant import data while shifting the now-empty 'planned' lines up.
Sub fix_planned()
Dim rw As Long
With Worksheets("Sheet1")
For rw = .Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If LCase(Left(.Cells(rw, 1).Value2, 8)) = "planned:" Then
.Range(.Cells(rw, 1), .Cells(rw, Columns.Count).End(xlToLeft)).Copy _
Destination:=.Cells(rw, 1).Offset(-1, 4)
.Rows(rw).EntireRow.Delete
End If
Next rw
End With
End Sub
Suggest you fix the source of the data so you do not have to repeatedly repair the data 'after-the-fact'.

How to move to next blank cell?

I have data on multiple sheets in a workbook that I want copied all to one sheet in that same workbook. When I run the macro, I would like it to start by deleting the current data in the "iPage Data Export" sheet and then replacing it with data from the other sheets.
I want the process to occur one column at a time since I may not bring over everything. Right now I am trying to learn how to do just one column.
I was able to get it to copy all of the contents of a column from one sheet, but when it moves to the next sheet, it overwrites the existing data. In the end, I only get one sheets worth of data copied.
Here are my 4 problems:
How do I make it clear the data on this sheet before running the routine?
How can I make it start each copy function at the bottom of that row (i.e. after the last cell with a value)? I have tried many of the suggestions on this and other boards without success. I will admit I am not very experienced in this.
How can I make it copy to a particular column (currently it just seems to default to A.
How can I concatenate multiple columns during the paste function? I.e. what if I want it to insert: A2&", "B2 instead of just A2
Sub CombineData()
Dim Sht As Worksheet
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> "iPage Data Export" Then
Sht.Select
Range("C:C").Copy
Sheets("iPage Data Export").Select
ActiveSheet.Paste
Else
End If
Next Sht
End Sub
How do I make it clear the data on this sheet before running the routine?
Sht.Cells.ClearContents
How can I make it start each copy function at the bottom of that row (i.e. after the last cell with a value)? I have tried many of the suggestions on this and other boards without success. I will admit I am not very experienced in this.
Range("C" & Rows.Count).End(xlUp).Offset(1, 0)
In detail:
Rows.Count will return the number of rows in the sheet, so in the legacy style *.xls workbooks this would return the number 65,536. Therefore "C" & Rows.Count is the same as C65536
Range("C" & Rows.Count).End(xlUp) is the same as going to C65536 and pressing Ctrl + ↑ - The command End(xlDirection) tells the program to go the last cell in that range. In this case, we would end up at the last cell containing data in column C.
.Offset(1, 0) means that we want to return the range offset by an amount of rows and/or columns. VBA uses RC (Rows Columns) references, so whenever you see something like the Offset() function with two numbers being passed as the arguments, it usually relates to the row, and the column, in that order. In this case, we want the cell that is one row below the last cell we referenced.
All-in-all the phrase Range("C" & Rows.Count).End(xlUp).Offset(1, 0) means go to the last cell in column C, go up until we hit the last cell with data, and then return the cell below that - which will be the next empty cell.
How can I make it copy to a particular column (currently it just seems to default to A.
Range("C:C").Copy Destination:=Sheets("iPage Data Export").Range("A:A")
You can pass the Destination argument in the same line and actually bypass the clipboard (faster and cleaner)
How can I concatenate multiple columns during the paste function? I.e. what if I want it to insert: A2&", "B2 instead of just A2
Lets say you wanted to reference column A, B, and F - just use:
Range("A1, B1, F1").EntireColumn
To summarise, you could streamline your existing code to something like (untested):
Sub CombineData()
Dim Sht As Worksheet
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> "iPage Data Export" Then
Sht.Range("C1:C" & Cells(Sht.Rows.Count, 3).End(xlUp).Row).Copy Destination:=Sheets("iPage Data Export").Range("A:A")
End If
Next
End Sub
This should do for the copying:
Sub CombineData()
Dim sheet As Worksheet
For Each sheet In Worksheets
If (sheet.Name <> "iPage Data Export") Then
sheet.Select
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Worksheets("iPage Data Export").Activate
Cells(1, ActiveCell.SpecialCells(xlCellTypeLastCell).Column + 1).Select
ActiveSheet.Paste
End If
Next
End Sub
For the concatenation you need to be more specific - but I guess you should open a new question with a clearer focus if you need specific help on that.

How to delete rows that had formulas before value paste?

I got an spread sheet that include formulas and I wrote a vb code to value paste.
Depending on the input file number of rows that filled is varied and I need to delete the rows those had formulas and now empty. (This is using as connector and otherwise it some how pick these extra rows which is unnecessary)
Sheet2.Range("G2:G298").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Above code not doing anything...
If the blanks are results of a formula like:
=""
Entered into a cell and then copied and paste as values, those are not really blank cells.
Instead, those are cells that looks blank but contains zero length strings.
SpecialCells(xlCellTypeBlanks) and even Excel formula ISBLANK won't work on it.
One way is to loop through the range and check all that contains "" and delete it.
Dim c As Range, rngtodelete As Range
For Each c In Sheet2.Range("G2:G298")
If Len(c.Value) = 0 Then
If rngtodelete Is Nothing Then Set rngtodelete = c _
Else Set rngtodelete = Union(rngtodelete, c)
End If
Next
If Not rngtodelete Is Nothing Then rngtodelete.EntireRow.Delete xlUp
Another way is using AutoFilter like this:
Sheet2.Range("G2:G298").AutoFilter 1, "="
Sheet2.Range("G2:G298").SpecialCells(xlCellTypeVisible).EntireRow.Delete xlUp
I'm assuming that G2 does not contain your header but the start of your data.
If it happens to be your header, you'll need to use offset when deleting.
Sheet2.Range("G2:G298").Offset(1, 0) _
.SpecialCells(xlCellTypeVisible).EntireRow.Delete xlUp
Sheet2.AutoFilterMode = False
I'm not completely sure what you mean by "This is using as connector", but I believe it has to do with an export/import process to another application.
As mentioned, a zero length string is not the same as a truly blank cell. However, you can rid your worksheet of them easily. The fastest method I am aware of is a quick cyclic run through all of the columns, applying Text-to-Columns ► Fixed width ► Finish to each.
When that is done, the zero length strings will be reverted to truly blank cells but the worksheet's used range will still overlap those empty cells found at the bottom of the dataset. This means that any export to an external program will try to export those cells. Just run .UsedRange to get Excel to reevaluate the actual used range.
First, tap Ctrl+End to see what Excel thinks is the last used cell on the worksheet. Next, run the following macro.
Sub prep_for_export()
Dim c As Long
Debug.Print Sheets("Sheet1").UsedRange.Address(0, 0)
With Sheets("Sheet1")
For c = 1 To .Cells(1, Columns.Count).End(xlToLeft).Column
.Columns(c).TextToColumns Destination:=.Cells(1, c), _
DataType:=xlFixedWidth, FieldInfo:=Array(0, 1)
Next c
End With
Sheets("Sheet1").UsedRange
Debug.Print Sheets("Sheet1").UsedRange.Address(0, 0)
End Sub
Edit Sheet1 in all four places if you have to before running it.
That is a little homogeneous but I think it should work for your purposes. After running the macro, tap Ctrl+End back at your worksheet again to see what Excel thinks is the last used cell on your worksheet. The before and after range addresses were recorded to the VBE's Immediate window as well.

Searching a column and evaluating adjacent cell in excel

I'm trying to make a spreadsheet that can tell me when somebody is in doing two things at the same time. say column A contains names, column B has the sign in time, and C has Sign out time. I am trying to find a way to assess whether any other instances of the same name had overlap in the time in and time out. I considered Vlookup, but that only gets me to the first instance.
Essentially I'm looking for if(A from this row exists anywhere else in column A and the adjacent B cell >= this row's B cell and the adjacent C cell >= this row's C cell, then true, otherwise do something else)
I work in a machine shop, and it's very common for people to work two machines at the same time. I understand my example a moment ago was only one of several possible ways the times could overlap, but if I could get help getting that far I would be ecstatic. even pointing me in the broadest of directions like "not possible without learning to code" would be helpful.
My excel skills are limited essentially to what I can learn in the help file, and as of now I'm ok with ifs. Any help would be appreciated. Do I need to learn VBA for this?
I am not an Excel power user. I learnt VBA because of employers who provided me with Excel but would not allow me use of other programmable tools. I have never made serious use of the more advanced capabilities of Excel. There are a surprising number of questions that get the comment, "you could do this with a Pivot table" but never an explanation of how. To be fair questions about Pivot Table belong on the SuperUser site but I find it a really unhelpful comment.
I do not know and do not care if your requirement can be met with a Pivot Table. I wish to show how simple tasks can be solved with VBA even if they cannot be solved with advanced Excel functionality. The macro below did not take long to write and I believe it meets your requirement.
Yes you should learn VBA. It does not take long to learn the basics and it can be used to solve many simple problems. I cannot imagine not being able to create macros or programs to solve day-to-day problems.
Search the web for "Excel VBA tutorial". There are many to choose from. Try a few and complete one that matches your learning style. I prefer books to online tutorials. I visited a large library and checked out their Excel VBA Primers. I then bought the one that worked best for me.
I will admit there is a lot of practice behind the macro below but I believe the real skill is in breaking your requirement into steps that can be solved easily with Excel VBA.
I created a worksheet Log which I filled with data that matches my understanding of your data. Perhaps your people do not run so many machines at the same time but I wanted to test my macro thoroughly.
The macro creates a copy of this worksheet (in case you do not want it sorted) and names it Temp. It then sorts Temp by Name and Sign-on time to give:
The macro compares adjacent rows and copies overlaps to worksheet Overlap:
Finally it deletes worksheet Temp.
My objective was to fully explain what the code does but not how the macro does it. Once you know a statement exists, it is usually easy to look it up. Come back with questions if necessary but the more you can decipher for yourself the faster you will develop your skills.
Option Explicit
Sub FindOverlap()
Dim RowOverCrnt As Long
Dim RowTempCrnt As Long
Dim RowTempLast As Long
Dim WithinOverlap As Boolean
Dim WshtLog As Worksheet
Dim WshtOver As Worksheet
' My principle reason for using worksheet objects is so the names appear in a single place.
Set WshtLog = Worksheets("Log") ' Change Log to your name for the source worksheet
Set WshtOver = Worksheets("Overlap") ' Change Log to your name for the destination worksheet
' Create temporary copy of worksheet "Log" in case sequence must be preserved.
' This is not necessary if you do not care if worksheet Log is sorted.
WshtLog.Copy After:=Sheets(Worksheets.Count)
Sheets(Worksheets.Count).Name = "Temp"
' Clear any existing data from destination worksheet and copy the headings from the
' source worksheet
With WshtOver
.Cells.EntireRow.Delete
WshtLog.Rows(1).Copy Destination:=.Range("A1")
End With
RowOverCrnt = 2 ' First to which rows from worksheet Log will be copied
' Sort worksheet Temp by Name and Sign-in time
With Worksheets("Temp")
With .Cells
.Sort Key1:=.Range("A2"), Order1:=xlAscending, _
Key2:=.Range("B2"), Order2:=xlAscending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
End With
' This is the VBA equivalent of selecting the cell at the bottom of column A
' and clicking Ctrl+Up. With the keyboard, this move the cursor up to the first
' cell with a value and selects that cell. That is, it selects the last cell from
' the top with a value. This statement sets RowTempLadst to the row number of that
' cell.
RowTempLast = .Cells(Rows.Count, "A").End(xlUp).Row
WithinOverlap = False ' Not currently within a set of rows that overlap.
' I assume row 2 is the first data row. This loop checks a row for an overlap with
' the previous row. This is why the start row is 3.
For RowTempCrnt = 3 To RowTempLast
If .Cells(RowTempCrnt, "A").Value = .Cells(RowTempCrnt - 1, "A").Value And _
.Cells(RowTempCrnt, "B").Value < .Cells(RowTempCrnt - 1, "C").Value Then
' The current row and the previous row are for the same person and
' the start time of the current row is before the end time of the previous row
If WithinOverlap Then
' Previous rows have overlapped and have been copied to worksheet Overlap.
' Add current row to end of current set of overlaps
.Rows(RowTempCrnt).Copy Destination:=WshtOver.Cells(RowOverCrnt, "A")
RowOverCrnt = RowOverCrnt + 1 ' Advance to next free row
Else
' The current and previous rows overlap. Copy both to worksheet Overlap.
.Rows(RowTempCrnt - 1 & ":" & RowTempCrnt).Copy _
Destination:=WshtOver.Cells(RowOverCrnt, "A")
RowOverCrnt = RowOverCrnt + 2 ' Advance to next free row
WithinOverlap = True ' Record within overlap set
End If
Else
' Current row does not overlap with previous
If WithinOverlap Then
' An overlap set has ended
RowOverCrnt = RowOverCrnt + 1 ' Leave gap between overlap sets
WithinOverlap = False ' Record no longer within overlap set
End If
End If
Next RowTempCrnt
End With
' Delete worksheet Temp
' "Application.DisplayAlerts = False" suppresses the "Are you sure you want to delete
' this worksheet?" question.
Application.DisplayAlerts = False
Worksheets("Temp").Delete
Application.DisplayAlerts = True
End Sub