I have been trying to create a vba code to rebuild a table with the information fed into it. What the code should do is the following:
Look in column G for the first none empty and non 0 cell and copy that value to the first #N/A in column C. Finally recalculate row for the first cell found in column C.This is the code I have.
i = 3
For i = 3 To 79
If Cells(i, 7).Value > 0 And Cells(i, 7).Value <> "" Then
MovingValue = Cells(i, 7).Value
Cells(i, 7).Copy
j = 3
For j = 3 To 4
If Cells(j, 3).Text = "#N/A" Then Exit For
Cells(j, 3).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Cells(i, 3).FormulaLocal = "=VLOOKUP(B" & (i) & ";'Cleaning step 2'!B:C;2;0)-" & MovingValue
Next j
End If
Next i
What I can't get it to do is, jump out of the code after it has completed this cylce an redo it for a new run. Recheck column G for first non empty and non 0. etc.
Can anyone help me?
Related
Here is my code:
For j = 3 To 37 Step 2
If PaddleBDateInstalledTextBox.Value = Cells(j, 8).Value Then
Cells(j, 8).Copy
Range("D42").PasteSpecial Paste:=xlPasteValues
Range("D42").PasteSpecial Paste:=xlPasteFormats
Range("D42").PasteSpecial Paste:=xlPasteAllUsingSourceTheme '<--
cells background, etc.
Range("D42").NumberFormat = "MM/DD/YY"
Cells(j, 8).Clear
End If
Next
I have one cell where the format is a date and I am trying to copy it first and then paste it into another cell but my cell did not have the value pasted in it and the original cell; and the contents were not cleared.
I have another cell that has the format Today() and I want to just copy the value without the formula into another cell but i have failed as well.
The last cell that I want to copy has a formula of =($I$2-H2)+(G2-F2) and I have the same problem.
This code worked for me:
If 1 = Cells(1, 1).Value Then 'Assuming in Cell(1, 1) is the value 1
Cells(1, 1).Copy
Range("B1").PasteSpecial Paste:=xlPasteValues
Range("B1").PasteSpecial Paste:=xlPasteFormats
Range("B1").PasteSpecial Paste:=xlPasteAllUsingSourceTheme
Range("B1").NumberFormat = "MM/DD/YY"
Cells(1, 1).Clear
End If
Maybe the Cells(j, 8).Value is your problem. What value does j have? If j is a variable your code should be right, but if you mean J as column name the code should be Range("J" & 8).Value or Cells(8, "J").Value instead of Cells(j, 8).Value
I'm trying to have a "Called Sub" paste data after the last row used in the one that is calling the code.
However, I can only manage to have the first sub to paste the first data selected and when "ESTDEUDA" is called it pastes the other data on information first used.
Sub ActualizarFondos()
'Deuda
J = 12
For i = 15 To 26
Sheets("Reporte").Activate
If Cells(i, "C").Value > 0 Then
Range(Cells(i, "C"), Cells(i, "B")).Copy
ActiveSheet.Range(Cells(J, "Z"), Cells(J, "AA")).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Call ESTDEUDA
J = J + 1
End If
Next
End Sub
Sub ESTDEUDA()
J = 12
For i = 3 To 6
Sheets("FondosEstrategia").Activate
If Cells(i, "F").Value > 0 Then
Range(Cells(i, "E"), Cells(i, "F")).Select
Range(Cells(i, "E"), Cells(i, "F")).Copy
Sheets("Reporte").Activate
Range(Cells(J, "Z"), Cells(J, "AA")).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
J = J + 1
End If
End Sub
I'd like to know what can be done in order to have the information from sheet "FondosEstrategia" to be pasted after the infomation pasted from sheet "Reporte".
Is there any way that a kind of J = J +1 is applied to "ESTDEUDA" in order to paste after J = J +1 from "ActualizarFondos".
Thanks!
You do not need to use J. Just offset your i value in your first loop to produce desired J value.
On your first loop:
i = 15
J = 12 which is the same is i - 3.
Therefore, you can swap out every instance of J with i - 3.
Next, you can pass i as a parameter (input) into ESTDEUDA using the below method.
Sub ActualizarFondos()
Dim i As Integer
For i = 15 To 26
With Sheets("Reporte")
If .Cells(i, "C").Value > 0 Then
.Range(.Cells(i, "C"), .Cells(i, "B")).Copy
ThisWorkbook.Sheets("WHATSHEET").Range("Z" & i - 3).PasteSpecial Paste:=xlPasteValues
Call ESTDEUDA(i)
End If
End With
Next i
End Sub
Sub ESTDEUDA(i As Integer)
Dim x As Long
For x = 3 To 6
With Sheets("FondosEstrategia")
If .Cells(x, "F").Value > 0 Then
.Range(.Cells(x, "E"), .Cells(x, "F")).Copy
Sheets("Reporte").Range("Z" & i - 3).PasteSpecial Paste:=xlPasteValues
End If
End With
Next x
End Sub
Also, you need to qualify your instances of Range and Cells with a direct sheet. You should avoid relying to Active or Selected sheet.
I use the following two macros to cleanse data i receive in one column, the first is to cleanse the data for rows containing certain words that aren't required. The second transposes this column into rows identified by a variable (in this case X). Both theses scripts are now coming up with mismatch error 13's when I run them on a new desktop. If anyone can help with a fix would be greatly appreciated!
Thanks
Sub deletewordsandblanks()
Last = Cells(Rows.Count, "A").End(xlUp).Row
For i = Last To 1 Step -1
If (Cells(i, "A").Value) = "Surname" Then
Cells(i, "A").EntireRow.Delete
End If
Next i
End Sub
and the transpose is done by:
Sub transpose()
Dim i As Long, lRow As Long, n As Long, j As Long
lRow = Range("A" & Rows.Count).End(xlUp).Row
n = 1
j = 1
For i = n To lRow
If Cells(i, 1).Value = "X" Then
Range(Cells(i, 1), Cells(n, 1)).Copy
Range(Cells(j, 2), Cells(j, i)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, transpose:=True
Application.CutCopyMode = False
n = i + 1
j = j + 1
End If
Next i
Columns(1).Delete
End Sub
The issue was not with the code but the data was not correctly formatted and generating the mismatch. It was due to the conversion from the scanned documents into the column.
Apologies for the mistake and Thanks for your help guys!
I want to build a table on one Excel Sheet "Ship" by pulling data from another excel sheet "Efficiency." The row data on the "Efficiency" sheet is categorized by "Shipped", "Leave", "Import" and "Export".
Each category (shipped, leave, import, export) has several items and they're in no specific order. The table on the "Efficiency" sheet occupies columns A:H, and starts at row 2; the length can vary.
I want to be able to search the rows for "Shipped" and copy columns A, D:F and H of the matching rows and paste them beginning at cell B4 of the "Ship" sheet. Can anyone help me please?
Sub Ship()
ActiveSheet.Range("$A$1:$H$201").AutoFilter Field:=4, Criteria1:="Shipped"
' this is looking in a specific range, I want to make it more dynamic
Range("A4:A109").Select
'This is the range selected to copy, again I want to make this part more dynamic
Application.CutCopyMode = False
Selection.Copy
Range("A4:A109,D4:F109,H4:H109").Select
Range("G4").Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("Ship").Select
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
This code has been tested based on your the information as given in your question:
Sub Ship()
Dim wsEff As Worksheet
Dim wsShip As Worksheet
Set wsEff = Worksheets("Efficiency")
Set wsShip = Worksheets("Shipped")
With wsEff
Dim lRow As Long
'make it dynamic by always finding last row with data
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
'changed field to 2 based on your above comment that Shipped is in column B (the code you posted has 4).
.Range("A1:H" & lRow).AutoFilter Field:=2, Criteria1:="Shipped"
Dim rngCopy As Range
'only columns A, D:F, H
Set rngCopy = Union(.Columns("A"), .Columns("D:F"), .Columns("H"))
'filtered rows, not including header row - assumes row 1 is headers
Set rngCopy = Intersect(rngCopy, .Range("A1:H" & lRow), .Range("A1:H" & lRow).Offset(1)).SpecialCells(xlCellTypeVisible)
rngCopy.Copy
End With
wsShip.Range("B4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
try the below code
Sub runthiscode()
Worksheets("Efficiency").Select
lastrow = Range("A" & Rows.Count).End(xlUp).Row
startingrow = 4
For i = 2 To lastrow
If Cells(i, 2) = "Shipped" Then
cella = Cells(i, 1)
celld = Cells(i, 4)
celle = Cells(i, 5)
cellf = Cells(i, 6)
cellh = Cells(i, 8)
Worksheets("Ship").Cells(startingrow, 2) = cella
Worksheets("Ship").Cells(startingrow, 5) = celld
Worksheets("Ship").Cells(startingrow, 6) = celle
Worksheets("Ship").Cells(startingrow, 7) = cellf
Worksheets("Ship").Cells(startingrow, 9) = cellh
startingrow = startingrow + 1
End If
Next i
End Sub
I have an Excel dataset that has animals in column a, and numbers in columns b, c, and d.
I would like to find a vba code that will take this dataset and do two things: transpose the numbers into a column, and then put the name of the associated animal into the adjacent cell. If you follow the link, sheet one shows the dataset that I have, and sheet 2 shows the dataset I would like to have.
you can see the dataset here: https://drive.google.com/file/d/0B8ss18LQyoQrdDVIQ2JMZmdPNVU/view?usp=sharing
This code will get me partway, but it doesn't do quite what I want it do to:
Sub moveandinsert()
Dim start_cell As Range
For i = 1 To 3
Set start_cell = Sheets("sheet1").Cells(i, 2)
Range(start_cell, start_cell.End(xlToRight)).Copy
Sheets("Sheet2").Select
lastRowA = Range("A" & Rows.Count).End(xlUp).Row + 1
Range("A" & lastRowA).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
For j = 1 To 12
If Cells(j, 1).Value > 0 Then
Sheets("Sheet1").Cells(i, 1).Copy
Sheets("Sheet2").Cells(j, 2).Select
Selection.PasteSpecial xlPasteAll
j = j + 1
End If
Next j
Next i
End Sub`
Any help will be appreciated
Try the following:
Sub moveandinsert()
Dim start_cell As Range
For i = 1 To 3
Set start_cell = Sheets("sheet1").Cells(i, 2)
Range(start_cell, start_cell.End(xlToRight)).Copy
Sheets("Sheet2").Select
lastRowA = Range("A" & Rows.Count).End(xlUp).Row + 1
Range("A" & lastRowA).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
For j = lastRowA To lastRowA + 4
If Cells(j, 1).Value > 0 Then
Sheets("Sheet1").Cells(i, 1).Copy
Sheets("Sheet2").Cells(j, 2).Select
Selection.PasteSpecial xlPasteAll
'j = j + 1
End If
Next j
Next i
End Sub
1) j = j + 1 is not required cuz j will increment itself in a for loop
2) you can use lastrowA as the starting point of your paste instead of hardcoded for j = 1 to 12