Replicating values - excel

Need a little help here.
In the "Data" Tab I want to copy values in column "c2:c1000" and paste in column "a1" of another Tab.
This is what i have so far,
Dim x As Long
Dim lastRow As Long
lastRow = Worksheet("Data").Cells(3, Columns.Count).End(xlUp).Column
For x = 1 To lastRow
If Worksheets("Sheet2").Cells(2, "A") = "" Then
Worksheets("Data").Range("c2:c1000").Copy Destination:=Worksheets("Sheet2").Range(1, "A")
Sheets("Sheet2").Range("A1").Value = Format(Now, "mm/dd/yyyy HH:mm:ss")
Else
Worksheets("Data").Range("c2:c1000").Copy Destination:=Worksheets("Sheet2").Cells(2,
Columns.Count).End(xlToLeft).Offset(, 1)
'Sheets("Sheet2").Range("A1").Value = Format(Now, "mm/dd/yyyy HH:mm:ss") --> can't figure how to increment this as this will need to be on the subsequent empty column
End If
Next
End Sub
Your help will be greatly appreciated!
Thank you.

Pasting values first into range A1 and down and then next time to cell B1 and so on, leaves no space for the timestamp to A1, B1 etc. So, I assume that you would like to paste the random values to row 2. So cells A1, B1, ... are left for the timestamp.
Inside the With statements we can refer to properties of the wsAudit so we can replace the "Worksheets("Audit")." reference with just "."
The column.count expression just checks the amount of columns in the worksheet.
The expression .Cells(2, Columns.Count) just points to last cell in the row 2.
The .End(xlToLeft).Column then looks from this column to left and is supposed to find the last not empty cell on this row. It's basically the same idea that in Excel's sheet you would go to cell XDF2 and hit CTRL+Arrow Left from keyboard.
But instead of activating the cell we just want to get the columns index number and then add 1 (the new column) and save it into variable. Now the new column is known.
The expression Range(.Cells(2, newColAudit), .Cells(1000, newColAudit)).Value is really the same as e.g. Range("B2:B1000"), but with this we can use the row and column index numbers instead. This is useful as the column number varies.
And as Samuel pointed out the copy paste operation can be avoided by setting the areas equal.
Dim wsAudit As Worksheet
Dim newColAudit As Long
Set wsAudit = Worksheets("Audit")
With wsAudit
newColAudit = .Cells(2, Columns.Count).End(xlToLeft).Column + 1
Range(.Cells(2, newColAudit), .Cells(1000, newColAudit)).Value = Worksheets("Data").Range("C2:C1000").Value
.Cells(1, newColAudit).Value = Format(Now, "mm/dd/yyyy HH:mm:ss")
End With

Much like your LastRow* variable for your source sheet, create a LastColumn variable for your destination sheet, which will find the last used column the same way you are finding your last used row.
Like so:
Dim LastColumn As Long
LastColumn = Sheets("Audit").Cells(1, Columns.Count).End(xlToLeft).Column
Then use the variable like so:
Destination:= Worksheets("Audit").Cells(1, LastColumn)
It seems that your code contradicts your question too, in your question you explained the data will be written to the Audit sheet in row 1, using the next column each time but your code looks for values in row 2 in your If statement:
If Worksheets("Audit").Cells(2, "A") = "" Then is the same as If Worksheets("Audit").Range("A2") = "" Then.
If you mean to check the first row, change the 2 to 1.
To help improve your codes efficiency:
(Also see the link to 'how to avoid select' in that question):
You can achieve 'copy/paste' without actually using the 'copy' and 'paste' methods by assigning the value of one range to the other, as example, like so:
Worksheets("Audit").Cells(1, LastColumn).Resize(999, 1) = Worksheets("Data").Range("c2:c1000").Value
Note: Change the Resize Property rows to suit the source range (in this case you are wanting to move values from C2:C1000).
*The LastRow variable is a bit confusing, as it is looking for the last used column in row 3.
If it's meant to find a column, consider renaming it to avoid confusion later on in debugging.
If it's meant to find the last row, try like this:
LastRow = Worksheet("Data").Cells(Rows.Count, 1).End(xlUp).Row

Related

Insert Row Every Two Rows and Subtract the Difference

I have numerous excel sheets that contain rows that have paired data. Specifically, I need to subtract the first row from the one that follows (e.g., row 2-row 1; row 4-row3; etc.) and place the result into a new row below each pair. My data in each sheet appear as follows:
I am not new to programming languages, but I am new to visual basic.
My current code is:
Sub test() Dim rng As Range
Columns(1).Insert
With Range("b2", Range("b" & Rows.Count).End(xlUp)).Offset(, -1)
.Formula = "=if(mod(row(),2)=1,1,"""")"
.Value = .Value
.SpecialCells(2, 1).EntireRow.Insert
End With
Columns(1).Delete
With Range("a1", Range("a" & Rows.Count) _
.End(xlUp)(2)).Resize(, 3)
.Columns(1).SpecialCells(4).Value = "Difference"
Union(.Columns(2).SpecialCells(4), .Columns(3) _
.SpecialCells(4)).Formula = _
"=r[-1]c-r[-2]c"
End With
End Sub
However, the result is this:
I am mainly interested in calculating the differences between row pairs in the first column shown, but it is clearly not working.
Any help would be greatly appreciated!
Easier to use formulae, rather than VBA.
Go to a second sheet in the file ("Sheet2")
Enter in A1: =Sheet1!A1-Sheet1!A2
On Sheet2, select Rows1 AND 2.
Drag down.
Then depends on what you need to do.
May be Copy | Paste Special | Values to Sheet3, and sort to remove blank rows.

Moving Data to new tab and reformatting it to make it easier to Export To Access

We currently have a spreadsheet that is used for scheduling, the gentleman using it doesn't want it changed so what I was thinking was create a new sheet with different formatting using VBA or a macro or?? I will then be able to import the new sheet into access where it is needed for a different program. I am attaching 2 different pictures the first is what it looks like now and 2nd is what I would like it to look like.
Old format
Better picture of Old Format
New format
. I have not done a lot of coding in Excel, normally just ='Sheet1'!E5, but didn't see how I could move the date properly and then not have the date show up any where else. The schedule may have 1 item assigned for a day or multiple items. If I have left something out that would be helpful please let me know.
If I understand you correctly...
The old format is something like this :
The expected result for the new format :
If that's what you mean...
Sub test()
Dim rg As Range: Dim cell As Range
Dim rgCnt As Range: Dim cnt As Long
Sheets("Sheet1").Copy Before:=Sheets(1)
With ActiveSheet
.Name = "TEST"
.Columns(1).Insert
.Range("A1").Value = "DATE"
Set rg = .Range("C2", .Range("C" & Rows.Count).End(xlUp))
End With
For Each cell In rg.SpecialCells(xlCellTypeBlanks)
Set rgCnt = Range(cell.Offset(1, 0), cell.Offset(1, 0).End(xlDown))
If cell.Offset(2, 0).Value = "" Then cnt = 1 Else cnt = rgCnt.Rows.Count
cell.Offset(1, -2).Resize(cnt, 1).Value = cell.Offset(0, 1).Value
Next
rg.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
There is a consistent pattern in the old format, where to the right of each blank cell in column B is the date. So we use the blank cell in column B as the benchmark to get the date in column C.
The process:
it copy sheet1 where the old format is.
name the copied sheet to "TEST"
insert one column, and put the header name "DATE"
since HD-2 now is in column C (after insert one column)
so the code make a rg variable to data range in column C.
Then it loop to only the blank cell in rg
set the range to check how many data under each date into rgCnt variable
if the looped cell offset(2,0) is blank then there is only one data under the date so it make the value of cnt variable = 1
if the looped cell offset(2,0) is not blank then there is more than one data under the date, then have the value of cnt from the rgCnt rows count.
then it fill column A (DATE header) with the date as many rows defined by the cnt value.
After the loop done, it delete the entire row of all blank cell in rg variable.

Incremental Numbering while skipping over certain cells

I am trying to do an incremental numbering in Excel, but for a specific condition. If the condition does not match, then it should keep the existing cell details.
Image:
As you can see from the picture, I want to create a numbering list in column B, which is based off information shown in the corresponding row in column D. So on the second row, I would the counting to start at "1" and then continue to expand only as the count of "is_null" and "equal" grows. At the same time, I want it to skip over the green and blue cells and keep the contents as is.
As of right now, I have done the following formula:
=COUNTIF($D$1:D2,"is_null")+COUNTIF($D$1:D2,"equals")
This does the proper numbering, however it over-writes the green and blue cells instead of keeping them as "A" and "stop" respectively.
If someone can help me with that issue, then I should be good to go. Thanks!
I'm not sure what the value should be if in Column D you find the String "set_path" or "stop", but if these are always the same (i.e. "a" if Column D = "set_path" and "stop" if Column D = "stop"), you could achieve your desired results with the following formula:
=IF(AND(D2<>"set_path",D2<>"stop"),COUNTIF($D$1:D2,"is_null")+COUNTIF($D$1:D2,"equals"),IF(D2="set_path","a",IF(D2="stop","stop","")))
UPDATE:
Using VBA you could leave the contents of the cell as they are without overwriting them with a formula using the code below:
Sub foo()
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
'declare and set the worksheet you are working with, amend as required.
Dim LastRow As Long, i As Long
LastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
'get the last row with data on Column D
For i = 2 To LastRow
If ws.Cells(i, "B").Value = "" Then 'if cell is empty add formula
ws.Cells(i, "B").FormulaR1C1 = "=COUNTIF(R1C4:RC[2],""is_null"")+COUNTIF(R1C4:RC[2],""equals"")"
End If
Next i
End Sub
Second Update:
I've now adapted the formula to increment the letters by one if "set_path" is found in Column D (Please bear in mind that this will go from A-Z and then it will start going through symbols as per ASCII table, so you might have to amend this if you want alternate behavior):
=IF(AND(D2<>"set_path",D2<>"stop"),COUNTIF($D$1:D2,"is_null")+COUNTIF($D$1:D2,"equals"),IF(D2="set_path",IFERROR(CHAR(COUNTIF($D$2:D2,"set_path")+64),""),IF(D2="stop","stop","")))

Excel VBA set print area to last row with data

I have an Excel table with a sheet "CR" where columns A to K are filled, with the first row being a header row.
Rows 1-1000 are formatted (borders) and column A contains a formula to autonumber the rows when data in column F is entered.
Sheet "CR" is protected to prevent users from entering data in column A (locked).
Using the Workbook_BeforePrint function, I'm trying to set the print area to columns A to K and to the last row of column A that contains a number.
My code (in object 'ThisWorkbook') is as follows:
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim ws As Worksheet
Dim lastRow As Long
Set ws = ThisWorkbook.Sheets("CR")
' find the last row with data in column A
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
ws.PageSetup.PrintArea = ws.Range("A1:K" & lastRow).Address
End Sub
However, when I click File -> Print, the range of columns A to K up to row 1000 is displayed instead of only the rows that have a number in column A. What am I doing wrong?
Change:
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
To:
lastRow = [LOOKUP(2,1/(A1:A65536<>""),ROW(A1:A65536))]
.End(...) will act like ctrl + arrow-key. if the cell has a formula (which looks empty due to the formula, then it will still stop there... another way would be the use of evaluate (if you do not want to loop) like this:
lastRow = .Evaluate("MAX(IFERROR(MATCH(1E+100,A:A,1),0),IFERROR(MATCH(""zzz"",A:A,1),0))")
This will give the last row (which has a value in column A).
Also check if there are hidden values (looking empty due number format or having characters you can't see directly. Try to go below row 1000 in column A (select a cell after A1000 in column A) and hit ctrl+up to validate where it stops (and why).
EDIT:
(regarding your comment)
"" still leads to a "stop" for the .End(...)-command. So either use my formula, translate the formula into vba or loop the cells it get the last value. Also Find is a good tool (if not doing it over and over for countless times).
lastRow = .Cells.Find("*", .Range("B1"), xlValues, , xlByColumns, xlPrevious).Row

Excel VBA - Substring & Paste

I have a column that has U.S. state abbreviations (MI, NY, FL, etc.). I have an issue where there is an observation that is listed as "NJ NJ". This observation moves around within the same column each week.
I want to create a macro that substrings each observation to two characters and just drops everything afterwords.
Would I be able to use the Mid function to grab the first two characters, and then paste it overtop of the original value. Further, would it be appropriate to offset by one or is there a way to do it all at once?
Thanks!
Assuming you have your List in the 1st Column, starting at Row 1, the following Macro will do it. Obviously you can make a lot of improvements and error checks to the code, but this should get you started.
Sub FixStates()
Dim lRow As Long
Dim lCol As Long
Dim strContent As String
lRow = 1
lCol = 1
Do While Cells(lRow, lCol) <> ""
strContent = Trim(Cells(lRow, lCol))
If Len(strContent) > 2 Then Cells(lRow, lCol) = Left(strContent, 2)
lRow = lRow + 1
Loop
End Sub
If you want your result to be offset by one cell from the source cell, then the formula by Daniel Cook works fine.
On the other hand, if you want your result to overwrite the source cell, you would have to copy the cell with the result (using the same formula as above) and paste-special as value on top of the source cell (you can do this for many cells at once), or write a VBA sub.
I personally find it simpler the "copy and paste-special as value" way.

Resources