Delete Blank Cells And Shift Up Fail [duplicate] - vba

This question already has answers here:
Delete blank cells in range
(6 answers)
Closed 4 years ago.
I've searched and tried alooot of solutions regarding this issue. But non of them worked. So im trying to attach the excel file here.
My issue is:
Column A
1324
12312
14
4323
12
11234
I want B to look like:
Column B
1324
12312
14
4323
12
11234
Looks simple. But it doesn't work since the Blank cells doesn't actually appear to blank. And I cant find a way to get rid of them. I'm attaching the excel file for your reference.
Excel File:
https://drive.google.com/open?id=1PDskY1GJKYhzzj905KrX988F8tTaNQSs

I believe the following will achieve your desired result, simply copy the code under your command button.
This will loop through row 1 to Last on Column A and if the cell is not blank it will pass the value to the next free row on Column B:
Sub foo()
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
'declare and set the worksheet you are working with, amend as required
LastRowA = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A
For i = 1 To LastRowA
'loop from row 1 to Last
LastRowB = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row + 1
'get the last row with data on Column B and offset by one (next empty row)
If ws.Cells(i, "A").Value <> "" Then ' if Column A's value is not empty
ws.Cells(LastRowB, "B").Value = ws.Cells(i, "A").Value 'pass that value to the next available row on Column B
End If
Next i
End Sub

Related

Comparing data from 2 sheets and copying data based on results

I have a workbook with 2 sheets that contain some of the same data. The first column in both worksheets contain a number assigned to an item, but sheet 2 contains more items
than sheet 1. Sheet 1 contains the items pertinent to me, so I am trying to copy the relevant data from sheet 2 into sheet 1.
For example:
Sheet 1
Column A
20
53
120
500
1123
etc
Sheet 2
Column A
1
2
3
4
5
etc
If the number in column A matches for both spreadsheets, I need to copy cell M from sheet 2 to cell I in sheet 1. I have tried a few different solutions posted elsewhere, but
since my data isn't ideally sorted between the two sheets, using things like VLookup wasn't working well.
I believe I need to store the information in column A in both sheets to an array and compare the data from there, I just have no clue how to write the code to continue
comparing the cell from sheet 1 until it finds a match in sheet 2, and then copy the data over.
Any help I can get would be greatly appreciated. Thanks everyone.
My current code:
Sub CopyFromSheet2()
Dim i As Long
Dim j As Long
Dim Range1 As Range
Dim Range2 As Range
Set Range1 = Sheets("Sheet1").Range("A:A")
Set Range2 = Sheets("Sheet2").Range("A:A")
For j = 1 To Range1
For I = 1 To Range2
If Sheets("Sheet1").Cells(i, "A").Value = Sheets("Sheet2").Cells(j, "A").Value Then
Sheets("Sheet1").Cells(i,"I").Value = Sheets("Sheet2").Cells(j, "M").Value
End If
Next i
Next j
End Sub
I am currently getting run time error 13 on the For j = 1 to Range1 line "Type mismatch"
Something to start with would be a loop from row 1 to last row in sheet 1, then for each of these rows, compare value of cell 1 to each value in sheet 2.
A way to compare them to each other would be like this:
If Sheets("sheet 1").Cells(i, "A").Value = Sheets("sheet 2").Cells(j, "A").Value Then
now you just need to put a nested loop around this and you are good to go.
To copy column m to i:
Sheets("sheet 1").Cells(i, "I").Value = Sheets("sheet 2").Cells(j, "M").Value
Now try out something and feel free to ask again if you are running into an error
So I ended up consolidating the columns I need into 1 spreadsheet to make things easier, and I found this question on SO: Comparing two columns, and returning a specific adjacent cell in Excel which was very similar to what I was trying to do. The formula
=IFERROR(VLOOKUP(C1, A:B, 2, 0), "")
worked perfectly for me, so I am using that instead of the VBA scrip.

Copy Pasting Range of different length using VBA

http://i.stack.imgur.com/93bt7.png
Hi,
I am trying to work with a code I have made but am having some trouble.
If you look at my photo above, in cell B3 I have a CUSIP. What I want to do is copy that CUSIP and paste it in each row of info for that CUSIP (so rows A4 till A8). Then I want to move to the second CUSIP in J3 (the CUSIPS are all in row 3 and 8 columns apart) and then paste the CUSIP in rows J4 to J35.
I want to keep doing this over and over for 1000 securities but the issue is that the rows differ in length.
My code is working until I get to the last piece of code which I have put in as a comment. It works but is static. Only works for moving from the 1st to 2nd security then fails. I am trying to think of a dynamic way for me to move from the cell which the CUSIP is last pasted in to the third row and corresponding column everytime (column will be 9 apart every time from the last pasted cell).
Here it is:
Sub CUSIP_Copy_Paste()
Dim LastRow As Long
Dim LastCol As Long
Dim c As Long
Dim r As Long
Range("B3").Select
LastCol = Cells(4, Columns.Count).End(xlToLeft).column
For c = 2 To LastCol Step 8
LastRow = Cells(Rows.Count, c).End(xlUp).row
ActiveCell.Copy
Cells(4, ActiveCell.Offset(1, -1).column).PasteSpecial xlPasteValues
For r = 5 To LastRow
Cells(r, ActiveCell.Offset(1, 0).column).PasteSpecial xlPasteValues
Next r
''''''ActiveCell.Offset(-5, 9).Select
Next c
End Sub
Thanks!
Your error lies in the final offset. Instead of -5, put in a variable, preferrably the variable which is the difference between the end of the rows count and the beginning, which is always 3.
That is to say, Offset(3 - lastRow, 9)
You almost had it friendo :)

Excel Inserting Function Columns Utilizing a Macro

I would like is a macro that after every 4 rows it inserts a function column which for row 3 down will include a function and rows 1 & 2 would be identical to the previous one and row 3 would say Planned orders.
I would like to add this identical macro to create every 5 after this one, then one for every 6 and one for every 7.
It can be 4 macros I just have to click in the right order not anything to fancy.
I created the macro below which inserts a row every 4th column, but I have to move the table over three columns to begin with and it doesn't generate the last column. How could I get the functions I want added to this column?
Sub insert_column_after_interval_4()
Dim iLastCol As Integer
iLastCol = Cells(1, Columns.Count).End(xlToLeft).Column ' same as CTRL+RIGHT ARROW
For colx = 5 To iLastCol Step 5
Columns(colx).Insert Shift:=xlToRight
Next
End Sub
Picture included for how the table currently looks, the end result would be just 4 additional formula columns after that and after every subsequent 4 columns in the spreadsheet.
The code below will insert 3 Columns after every fourth Column, the first column will be added into the sixth Column and then from there after every four columns there will be three columns inserted.
The data from the last two columns in the set of four columns will be pasted into the fist two columns of the new columns.
Two things to remember. You always want to use direct referencing to WorkBooks WorkSheets to avoid confusion in the program when multiple WorkBooks and WorkSheets are available.
Option Explicit
Sub InsertingColumns()
'Always want to directly reference the WorkBook and WorkSheet which contains your data
'Change Book1 and Sheet1 as per your requirement
Dim CurrentWorkSheet As Worksheet
Set CurrentWorkSheet = Workbooks("Book1").Worksheets("Sheet1")
Dim LastColumn As Long
LastColumn = CurrentWorkSheet.Cells(1, Columns.Count).End(xlToLeft).Column
'Step 7 to cater for the every forth Column plus the 7 columns being added
'Started at 6 because "After every four columns" means the fith Column and catering for the Cal Day in Column 1
Dim CurrentColumn As Long
For CurrentColumn = 6 To LastColumn Step 7
'Current Column to CurrentColumn + 2 will have 3 Cells selected
CurrentWorkSheet.Range(Cells(1, CurrentColumn), Cells(1, CurrentColumn + 2)).Insert Shift:=xlToRight
'Copy Data from the second column from the right and paste into the first new column
CurrentWorkSheet.Columns(CurrentColumn - 2).Copy
CurrentWorkSheet.Columns(CurrentColumn).PasteSpecial Paste:=xlPasteValues
'Copy Data from the first column from the right and paste into the second new column
CurrentWorkSheet.Columns(CurrentColumn - 1).Copy
CurrentWorkSheet.Columns(CurrentColumn + 1).PasteSpecial Paste:=xlPasteValues
Next CurrentColumn
End Sub
See BEFORE and AFTER Below:
For the 5, 6 and 7 inserts you can then just edit this four insert loop to cater for the others.

vba sub for paste row to last empty row or update based on column identifier

Q: I need to simply paste the values of the row at my discretion (button) so that they remain permanently where I pasted them.If they already exist there then update them otherwise paste to the last non empty row. From where they get copied the rows can change , new rows can come and go hence they'd need a unique identifier from the column
The only formula I have for a building block for doing this is:
Function paste() As Variant
macropastec4 = Sheets("Sheet1").Range("I3").Value
End Function
which I could assign to a button to paste the value of the one cell however I need rows and much more (see detailed description) so I don't know whether the right solution would incorp my building block at all!
detailed description:
How can I adjust this formula to paste a row of cells based on a cell value (unique identifier) in that row. I.e incorporating a unique reference in the row ie 1 in A1 in such a way that if I was to run the sub again it would just update the row that exists starting H10 where it has been copied with H10 containing that referred 1. If it was a new row it would populate the last empty row beginning either H12 or H11. I would have push button to run the vba function for each row to be copied so in O1 O2 O3 etc
A B C D E F G to H I J K L M N 1
"non empty cells containing 2
1 1 b c d e f g 8 previously pasted rows from(A:G) 3
2 2 i j k l m n 9 which have now disappeared"
3 3 p q 5 3 y z 10 1 b c d e f g
11 2 i j k l m n
12 3 p q 5 3 y z
The more complicated part lies in that A1 to G1 won't always contain 1,b,c,d,e,f,g but as I paste it to where it should be pasted ie in rows H to N according to my rules and at my discretion ( ie clicking on the vba sub button). At a certain time completely independant of when I run the sub for each row , the row A:Gwill dissapear and repopulate with something new. Moreover it will repopulate with whatever was below A1 to G1 ie A2 to G2 unless A2 to G2 has already disappeared in which case it would populate whatever remains just filling up to A1 to G1 hence why I would need the unique identifier being the 1 in A1 to work after this re-alignment whereby if I run the sub again it would recognize the 1 or the 2 and know its place within H to N again knowing to only update the existing row there (permanently pasted) or otherwise ( if it is a new line that exists ) to paste it to the last empty row under H to N
- i.e new rows can appear in A:G any time moving to the top or bottom
n.b. I only need the ability to paste the cells from A1:G3or further depending on how many rows there are ie it could be A1:G20 but I want the sub to cator for each row independantly through a button. How those rows A1:G20 re-populate and re-order themselves is dependant on of of the columns in the row. Ie they would repopulate if they had a similar column cell but that should be ignored in the framework of what I am trying to achieve, I need only reference to the unique identifiers in column A of the rows
other points
In cells A1 toG1ANDA2toG2` etc (basically every row) I will have a combination of number, letters (written text) and inserted references (LINKS) to sheets in Microsoft onenote. So I'd need the ability to have the same link copied over with the same alignment of the LINK button I have for that particular onenote file i.e aligned to cell etc. So basically just paste whatever is there in those cells!!
It is probably worth noting that the unique identifiers as they
repopulate won't be in any order - they will be completely random i.e
not neceserrily 1,2,3,4, could be 313,2,32131,2,33 but they will be numbers
I will also need this to referece the one sheet I am working on.
Please help me accomplish this! thanks in advance
Don't know if this helps
still no ideas? do these help?
Code:
Sub CopyRows()
Dim LastRow As Long
Dim destRng As Range
Application.ScreenUpdating = False
With Sheets("All Data")
Set destRng = .Range("B" & .Cells(.Rows.Count, "B").End(xlUp).Row + 1)
LastRow = Sheets("IDEAS").Range("C" & Rows.Count).End(xlUp).Row
Sheets("IDEAS").Range("B8:S" & LastRow).Copy Destination:=destRng
.Columns("B:S").AutoFit
End With
Application.ScreenUpdating = True
End Sub
maybe I could have one sub button for all rows to do this. Just need the above to filter for already existing rows with the identifier. :S So I need some form of the above with an if command and to paste values :S
this help:?
Sheets("Sheet1").Range("A1:F48").Copy
With Sheets("Sheet1").Range("H" & Rows.Count).End(xlUp).Offset(1)
.PasteSpecial Paste:=xlPasteColumnWidths
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
End With
Use VBA to paste values from one table to another
this with a paste not copy ?
I could reference cells with the currently displayed unique identifiers
Public Sub CopyRows()
Sheets("Sheet1").Select
' Find the last row of data
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
' Loop through each row
For x = 2 To FinalRow
' Decide if to copy based on column D
ThisValue = Cells(x, 4).Value
If ThisValue = "A" Then
Cells(x, 1).Resize(1, 33).Copy
Sheets("SheetA").Select
NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(NextRow, 1).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
ElseIf ThisValue = "B" Then
Cells(x, 1).Resize(1, 33).Copy
Sheets("SheetB").Select
NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(NextRow, 1).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
End If
Next x
End Sub

Comparing the cell values and printing the count in Excel using a formula or function?

I need a formula or function which is going to fulfill my below mentioned need. I have a excel data of around 11000 rows and data looks somewhat like in Column A:
Now in column B i want the result to be printed like it mentioned below: which literally means it should count the values present in column A and print it in the column B, I don't need to repeat count:
Column A Column B
PC-101 1
PC-101 1
PC-102 2
PC-102 2
PC-103 3
PC-104 4
PC-106 5
PC-107 6
PC-104 4
PC-106 5
PC-106 5
I tried with the "count" series formulas but the result was null.
Even i wrote the macro as given below( which i got from stackoverflow) but even it is printing the repeating count:
Sub CountOccurence()
' Reference: Microsoft Scripting Runtime
Application.ScreenUpdating = False
Set oDict = New Dictionary
Dim wS As Worksheet
Dim r As Integer, rLast As Integer
Set wS = Sheet1
rLast = wS.Cells(1, 1).CurrentRegion.Rows.Count
For r = 3 To rLast Step 1
If Not (oDict.Exists(wS.Cells(r, 1).Value)) Then
oDict.Add wS.Cells(r, 1).Value, 1
Else
oDict.Item(wS.Cells(r, 1).Value) = oDict.Item(wS.Cells(r, 1).Value) + 1
End If
wS.Cells(r, 2).Value = oDict.Item(wS.Cells(r, 1).Value)
Next r
Set oDict = Nothing
Application.ScreenUpdating = True
End Sub
Can anyone help me regarding this? Thanks in advance.
I tried with the "count" series formulas but the result was null.
A simple Excel formula can do this.
Put 1 in Cell B1 and then put this formula in cell B2 and pull it down.
=IF(COUNTIF($A$1:$A2,A2)>1,VLOOKUP(A2,A:B,2,0),B1+1)
Assuming that your data in column a is sorted, you can simply place 1 in B2 this formula in B3 and copy it down:
=IF(A2<>A3,B2+1,B2)
:-)