What I am trying to do is to take values from specific cells and make them a filldown column. I have multiple worksheets with different values in them.
This code is working as expected with one worksheet :
Sub Formatting_one()
Range("A12").Value = Range("M6").Value
Range("A12:A" & Cells(Rows.Count, 7).End(xlUp).Row).FillDown
End Sub
Then, I started to try the same thing but with looping through worksheets. That's the point I am stuck with. Here is my code for this :
Sub Formatting_many()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.[A1].Resize(, 6).EntireColumn.Insert
ws.Range("A12").Value = ws.Range("M6").Value
ws.Range("A12:A" & Cells(Rows.Count, 7).End(xlUp).Row).FillDown
ws.Range("B12").Value = ws.Range("M7").Value
ws.Range("B12:B" & Cells(Rows.Count, 7).End(xlUp).Row).FillDown
ws.Range("C12").Value = ws.Range("M8").Value
ws.Range("C12:C" & Cells(Rows.Count, 7).End(xlUp).Row).FillDown
ws.Range("D12").Value = ws.Range("I5").Value
ws.Range("D12:D" & Cells(Rows.Count, 7).End(xlUp).Row).FillDown
ws.Range("E12").Value = ws.Range("I4").Value
ws.Range("E12:E" & Cells(Rows.Count, 7).End(xlUp).Row).FillDown
ws.Range("F12").Value = ws.Range("I6").Value
ws.Range("F12:F" & Cells(Rows.Count, 7).End(xlUp).Row).FillDown
ws.Range("G12").Value = ws.Range("I7").Value
ws.Range("G12:G" & Cells(Rows.Count, 7).End(xlUp).Row).FillDown
Next ws
End Sub
I did a step by step, and the result is that the cell is copied in the first cell of the filldown range cells but then it's deleted. Can somebody help ?
The issue …
… is that you look for the last used row in column G
Cells(Rows.Count, 7).End(xlUp).Row
But since you added 6 columns with ws.[A1].Resize(, 6).EntireColumn.Insert column G is now empty, so the last used row is 1
and you actually run
ws.Range("A12:A1").FillDown
which takes the empty cell from A1 and fills it down until A12 (so your inserted value in A12 gets removed).
Solution
After inserting your original column G moved to
ws.Cells(ws.Rows.Count, 7 + 6).End(xlUp).Row
Related
Hi Hopefully somebody can help as i am missing something in my code.
I am trying to loop through a dynamic row from the last knowing value to the new values, then add these new values as a column headr in starting in row 3.
I have the first portion and can get the new values to paste into next blank column. the issue is i can't work out how to offset to the next empty cell. rather than pasting all new values into the same cell.
Sub Testnewname()
Dim Nw2 As Integer
Dim c As Long
Dim D As Long
Dim Lcol1 As Long
Dim Lrow2 As Long
Lcol1 = Cells(3, Columns.Count).End(xlToLeft).Column '' Find last column available in row 3
Lrow2 = Cells(Rows.Count, 10).End(xlUp).Row ''Find last row where new info is put via a table defined by names =UNIQUE(Table1[[#Data],[Company]],FALSE,FALSE)
Nw2 = Sheets("Cost Table").Range("$H$10").Value ''value of the old number of cells used to start from in loop
c = Lcol1 + 1 ''allocate a varable to last column + 1
For D = Nw2 To Lrow2 ''for d (i) from cell 19 to last cell
Cells(D, 10).Copy 'copy cell value
Cells(3, c).PasteSpecial xlPasteValues ''this is where is would of thought pasteinto last column whichit does. What seems to happen is id doesnt move to next column when it reloops
Next D ''would of expected that when it goes onto next loop that the C (Lcol+1) would recalculate
ThisWorkbook.Worksheets("Cost Table").Range("H11").Copy
ThisWorkbook.Worksheets("Cost Table").Range("H10").PasteSpecial Paste:=xlPasteValues ' takes the value from a CountA function in H11 and pastes into H10 to update the last place a cell value was prior to running macro and updates Nw2 for running the macro again
Application.CutCopyMode = False
End Sub
I have tried to add in a Second loop for the column but this does nothing
For C = Lcol to Lcol + 1
For D = Nw2 To Lrow2
Cells(D, 10).Copy
Cells(3, c).PasteSpecial xlPasteValues
Next D
Next C
Any help greatly appreciated
cheers
You should be able to do this without using a loop, or copy/paste:
Sub Testnewname()
Dim Nw2 As Long, ws As Worksheet, wsCostTbl As Worksheet, cDest As Range
Set ws = ActiveSheet 'or some other specific sheet
Set wsCostTbl = ThisWorkbook.Worksheets("Cost Table")
'next empty cell on row 3
Set cDest = ws.Cells(3, ws.Columns.Count).End(xlToLeft).Offset(0, 1)
'starting row# for copy
Nw2 = Sheets("Cost Table").Range("$H$10").Value
'using the source range...
With ws.Range(ws.Cells(Nw2, 10), ws.Cells(Rows.Count, 10).End(xlUp))
'...transfer the values, flipping rows and columns using Transpose
cDest.Resize(.Columns.Count, .Rows.Count).Value = Application.Transpose(.Value)
End With
wsCostTbl.Range("H10").Value = wsCostTbl.Range("H11").Value
End Sub
Hi thank you both for that, I have tested both ways and work for the life of me couldn't work out the possion of the C=C+1.
Tim i really like this with out looping i did try something like this as i have another script that i removed looping from as itwas so much quiker.
With ws.Range(ws.Cells(Nw2, 10), ws.Cells(Rows.Count, 10).End(xlUp))
'...transfer the values, flipping rows and columns using Transpose
cDest.Resize(.Columns.Count, .Rows.Count).Value = Application.Transpose(.Value)
End With
Is a new one for me and will be very useful in anumber of toold i am createing thank you for this
I have the below code where I need to make it work as below.
copy from row 10 till last row with value.
the last row will be with reference to column N starting from cell N10..
any suggestions from SO team?
wbSource.Sheets(SITE_TEMPLATE).Rows(10).EntireRow.Copy wbMaster.Sheets(SITE_TEMPLATE).Range("A" & insertRow2)
insertRow2 = insertRow2 + 1
Try this:
Sub test()
Dim LastRow As Long
With Workbooks("wbSource").Worksheets("SITE_TEMPLATE")
LastRow = .Cells(.Rows.Count, "N").End(xlUp).Row
.Rows(10 & ":" & LastRow).EntireRow.Copy wbMaster.Sheets(SITE_TEMPLATE).Range("A" & insertRow2)
insertRow2 = insertRow2 + 1
End With
End Sub
I'll try to explain this best as I can, and I attached an example pic of what I'm looking for help on.
Sheet 1 represents new data that comes into the workbook, Sheet 2 represents older data saved on the work book. I would like to run a script that replaces the whole row of data in Sheet 2 from Sheet 1 based on its matching reference. If Sheet 1 has an entry that does not find a matching a reference in Sheet 2, it then pastes the new value as the last row. This would ideally run as a loop until the last row of Sheet 1.
I tried working on it & come with this code. Hope this helps.
Sub insert()
Dim i As Integer
lastrow = Sheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
'SheetTwoEmptyRow = Sheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Row
Dim rgfound As Range
For i = 1 To lastrow
Set rgfound = Worksheets("sheet1").Range("A1:A500").Find("A" & i)
If rgfound Is Nothing Then
Worksheets("sheet1").Range("A" & i, "C" & i).Copy _
Destination:=Worksheets("sheet2").Range("E" & i, "G" & i)
Else
'do nothing
End If
Next i
End Sub
I am trying to create a summary list for people in a downstream application to feed several of my production machines. Each machine is going to have their own tab to request material, and I want all of their requests to be summarized on one tab (called "Core_Cutter_List").
So basically I am trying to create a VBA that will copy over a row from spreadsheet "2" into the next blank line on spreadsheet "Core_Cutter_List". I want it to copy if there is text in column A and column G is blank. I have limited knowledge of VBA. The code that I found was able to only test for one of my criteria which was that column G is blank, but basically it runs through every single cell on my file. Do you know how I can add the other criteria of column A having text in it so that it doesn't look through every cell on my sheet? Thanks for any help!
Sub Test()
'
' Test Macro
'
Sheets("2").Select
For Each Cell In Sheets(1).Range("G:G")
If Cell.Value = "" Then
matchRow = Cell.Row
Rows(matchRow & ":" & matchRow).Select
Selection.Copy
Sheets("Core_Cutting_List").Select
ActiveSheet.Rows(matchRow).Select
ActiveSheet.Paste
Sheets("2").Select
End If
Next
End Sub
If you need two conditions, then you should write them carefully in the IF statement with And:
Something like If cell.Value = "" And Len(cell.Offset(0,-6)) Then should be workable.
Using Select is a bit not advisable, but it works at the beginning - How to avoid using Select in Excel VBA
The Sub bellow does the following
Determine the last used row in Worksheets("2") based on values in column A
Determine the last used col in Worksheets("2") based on values in row 1
Determine the last used row in Worksheets("Core_Cutter_List") based on values in column A
Loop through all used rows in Worksheets("2")
If the cell in col A is not empty And cell in col G is empty
Copy entire row to next empty row in Worksheets("Core_Cutter_List")
Increment next empty row for Worksheets("Core_Cutter_List")
Loop to the next used row in Worksheets("2")
Option Explicit
Public Sub CopyRows()
Dim ws1 As Worksheet, ws2 As Worksheet, ws1r As Range, ws2r As Range
Dim ws1lr As Long, ws1lc As Long, ws2lr As Long, i As Long
Set ws1 = ThisWorkbook.Worksheets("2")
Set ws2 = ThisWorkbook.Worksheets("Core_Cutter_List")
ws1lr = ws1.Range("A" & Rows.Count).End(xlUp).Row 'last row in "2"
ws1lc = ws1.Cells(1, Columns.Count).End(xlToLeft).Column 'last col in "2"
ws2lr = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1 'last row in "Core_Cutter"
For i = 1 To ws1lr
If Len(ws1.Cells(i, "A")) > 0 And Len(ws1.Cells(i, "G")) = 0 Then
Set ws1r = ws1.Range(ws1.Cells(i, 1), ws1.Cells(i, ws1lc))
Set ws2r = ws2.Range(ws2.Cells(ws2lr, 1), ws2.Cells(ws2lr, ws1lc))
ws2r.Value2 = ws1r.Value2
ws2lr = ws2lr + 1
End If
Next i
End Sub
My test file
Worksheets("2")
Worksheets("Core_Cutter_List")
I have a report generated from a program that opens in excel similar to the image below
I have been using this code to sum the amounts:
Sub SumTotals()
lastrow = Sheets("sheet1").Cells(Rows.Count, 2).End(xlUp).Row
Range("b" & lastrow + 1) = WorksheetFunction.Sum(Sheets("sheet1").Range("b2:b" & lastrow))
Range("a" & lastrow + 1) = Cells(1, 1)
Range("a1:b" & lastrow).Select
Selection.Delete Shift:=xlUp
End Sub
The issue I am running into is that the code sums both company A and company B and the ends up
Company A 5,625.07
What I am trying to accomplish is
Company A 2,053.73
Company B 3,571.34
When I get these reports there is generally 100 + companies so if I can speed up the process it would be very beneficially.
I suspect the first line of code is the problem
lastrow = Sheets("sheet1").Cells(Rows.Count, 2).End(xlUp).Row
As this is placing the end at cell B8 instead of B3. I am trying to figure out how to sum the first column of numbers until the first blank row, and then carry on to the numbers below and carry out the same process. Any suggestions are appreciated.
ideal end result
Ideal result
Try this
Sub x()
Dim r As Range
For Each r In Columns(2).SpecialCells(xlCellTypeConstants).Areas
r(r.Count + 1).Value = Application.Sum(r)
r(r.Count + 1).Offset(, -1).Value = r(1).Offset(, -1).Value
r.EntireRow.Delete shift:=xlUp
Next r
End Sub
You can also try this non VBA approach. Enter this formula =IF(A1<>"",SUM(OFFSET(B1,0,0,MIN(IF(B1:B80="",ROW(B1:B80))))),"") in cell C1 to sum all values before blank row. drag formula to the bottom of your values. Since it is an array formula, you must enter it using CTRL+SHIFT+ENTER. You can then filter out blank values in column A to get your result.