Excel- Merge two worksheets with different text data - vba

I have two excel worksheets that have the same column and row information.
However, one of the sheets contains blank cells where the other document has text information (but both spreadsheets are too large to know exactly where one contains info and the other doesn't)
I want to merge the two worksheets such that the final "Master Worksheet" contains all the information contained in both worksheets.
I want to get all the information from: $T$5381:$AP$5400 of worksheet "B" and paste it into the same range in worksheet "A"
I have tried using the 'Consolidate' function in Excel, but that appears to only work if the data is numeric. I have tried to select all the data from one workbook, highlight the blanks of the other workbook and paste, but Excel won't let me because the "copy area and paste area are not the same size or shape."
Does anybody have any ideas?
So like this
Sheet 1
A B C
1 A C
2 Z
3
Sheet 2
A B C
1 X
2
3 L O R
Master Sheet
A B C
1 A C X
2 Z
3 L O R

Try something like this;
note: you may need to adjust the sheet names
Sub MergeData()
Application.ScreenUpdating = False
Dim A, B, C, i&, j&
Set A = Sheets("Sheet1")
Set B = Sheets("Sheet2")
Set C = Sheets("Sheet3")
For i = 1 To A.UsedRange.Rows.Count + 10
For j = 1 To A.UsedRange.Columns.Count + 10
C.Cells(i, j) = IIf(IsEmpty(A.Cells(i, j)), B.Cells(i, j), A.Cells(i, j))
Next j
Next i
Application.ScreenUpdating = True
End Sub

Related

Removing loops to make my VBA macro able to run on more data

in my data there are more than a thousand different six digit numbers that are reoccurring in no specific pattern. I need to find all six digit codes that exist in column A and for each number. For example 123456, then find summarize the value in column B for every row that has 123456 in column A. My code is not very effective but the runtime is not a problem if I run with only 10 rows. However, in the real data sheet there are 80 000 rows and my code will take to much time. Can someone help me edit my code but removing certain loops within loops or some stop conditions. I'm new to VBA and can't do it myself in the limited time I have.
Sub Test2()
Dim summa As Long
Dim x As Long
Dim condition As Boolean
Dim lRows As Long
Dim k1 As Integer
Dim i As Long
x = 1
Worksheets("Sheet1").Activate
For i = 100000 To 999999
k1 = 1
lRows = 10
condition = False
While k1 <= lRows
If Cells(k1, "A").Value = i Then
condition = True
End If
k1 = k1 + 1
Wend
If condition = True Then
Cells(x, "F").Value = Application.SumIf(Range("A:A"), CStr(i), Range("B:B"))
Cells(x, "E").Value = i
x = x + 1
End If
Next i
MsgBox "Done"
End Sub
You don't need VBA for this task. Follow these steps.
Insert a blank column C in a copy of the original data sheet.
Insert a SUMIF formula, like =SUMIF(A:A, A2, B:B) in C2 and copy all the way down.
Now all items 123456 will have the same total in column C
Copy column C and Paste Values (to replace the formulas with their values).
Delete column B.
Remove duplicates.

Generate table by VBA in Excel

I'm new in VBA. I hope that this is not a difficult question for you.My problem:
I have TEXT in column A and NUMBER in column B. Like this:
Column A Column B
TEXT 1 3
TEXT 2 2
TEXT 3 3
..... ...
I need to auto-generate a table in other sheet which has two columns. First contains the text which repeats n times (NUMBER in column B) and then the next text from Column A. In the second column of this table I need number from 1 to NUMBER. like this:
Column A Column B
TEXT 1 1
TEXT 1 2
TEXT 1 3
TEXT 2 1
TEXT 2 2
TEXT 3 1
TEXT 3 2
TEXT 3 3
.... ....
Then I have to post-process this table, but I know how to make it. I don't know how to generate the table.
Expanding on my comment:
Sub MakeTable()
Dim i As Long, j As Long, k As Long, m As Long, n As Long
Dim t As String
Dim ws As Worksheet
Sheets(1).Activate
Set ws = Sheets(2)
n = Cells(Rows.Count, 1).End(xlUp).Row()
k = 1
For i = 1 To n
t = Cells(i, 1).Value
m = Cells(i, 2).Value
For j = 1 To m
ws.Cells(k, 1).Value = t
ws.Cells(k, 2).Value = j
k = k + 1
Next j
Next i
End Sub
This assumes that the original data is in Sheet1 and you are transferring it to Sheet2, and that the data begins in row 1. Adjust accordingly if those assumptions are false. The way I determine the last cell in column A that has data is an important idiom in Excel VBA and should be mastered.

Split copy from non-adjoining Excel columns to non-adjoining Word table columns

Would like to copy three ranges of data from Excel and then paste the three different ranges in an existing Word table. The Word document is generated from another program and the file name is different each time. I need to split the three ranges up and paste into the word table(1) but in columns that do not match the Excel copy. Current process is Copy one Excel range, alt+tab to Word document and paste into table, repeat for remaining two ranges. This is my copy code but I need the "paste" help.
Sub Copy_CV()
Dim MaxVal As Long, C As Long
MaxVal = Worksheets("Prop").Application.Max(Columns(2))
C = MaxVal + 3
Worksheets("Prop").Range("G4:G" & C).Select
Worksheets("Prop").Range("L4:L" & C).Select
Worksheets("Prop").Range("M4:M" & C).Select
Selection.Copy
End Sub
You could do something like this:
Sub Copy_CV()
Dim MaxVal As Long, C As Long
MaxVal = Worksheets("Prop").Application.Max(Columns(2))
C = MaxVal + 3
'open Word with COM and late binding and open document
Dim Word As Object, Document As Object, Table As Object
Set Word = CreateObject("Word.Application")
Set Document = Word.Documents.Open("example.docx")
'get table
Set Table = Document.Tables(1)
'adjust rows
dif = Table.Rows.Count - MaxVal
If dif > 0 Then
For i = 1 To dif
Table.Rows(1).Delete
Next
ElseIf dif < 0 Then
For i = 1 To -dif
Table.Rows.Add
Next
End If
'copy each col in excel and paste in col in the new table
Worksheets("Prop").Range("G4:G" & C).Select
Selection.Copy
Table.Columns(1).Select 'this assumes that target rows are 1, 2 and 3
Word.Selection.PasteAndFormat 16 'wdFormatOriginalFormatting=16
Worksheets("Prop").Range("L4:L" & C).Select
Selection.Copy
Table.Columns(2).Select
Word.Selection.PasteAndFormat 16
Worksheets("Prop").Range("M4:M" & C).Select
Selection.Copy
Table.Columns(3).Select
Word.Selection.PasteAndFormat 16
'save and close document
Document.Save
Document.Close
Word.Quit
Set Table = Nothing
Set Document = Nothing
Set Word = Nothing
End Sub
This assumes you want to use the first table in your document. EDIT: added code to fix number of rows on target table.
Thanks for the response! Worked...kinda. Here's what I ran into, the code stops executing and hangs up on the Set Document line. After further consideration and your showing me possibilities, I have a couple of additional assistance requests. I only presented part of the process because I was only thinking one direction. The actual process is that 1) I copy and paste data from columns 5 and 6 of the Word table to Excel table G and L, 2) I adjust the data and generate column M then 3) I copy and paste Excel G, L and M back to Word table into columns 5, 6 and 7 then 4) since each Word column has unique formatting (has tabs which I could not duplicate) I have to select the title for each column and format each column using the format painter. I tried using macro recording to accomplish this but to without success because it would only format the first cell in the table.
Word Table
- Generated from separate program but variable rows each time.
Request
1) Access the open instance of the word document...possibly have an error handler if it hangs up
2) Copy the data from Word table 1 columns 5 & 6 and paste in Excel table column G & L
3) Copy the data from Excel table columns G, L & M and paste into Word table 1 columns 5, 6 & 7.
4) Format Word table columns 5, 6 & 7 based on format of the table row 2 cells of each column.
Word Table 1
Sub Copy_CV()
Dim MaxVal As Long, C As Long
MaxVal = Worksheets("Prop").Application.Max(Columns(2))
C = MaxVal + 3
'open Word with COM and late binding and open document
Dim Word As Object, Document As Object, Table As Object
Set Word = CreateObject("Word.Application")
Set Document = Word.Documents.Open("c:\test\Test.rtf")
'get table
Set Table = Document.Tables(1)
'
Worksheets("Prop").Range("G4:G" & C).Select
Selection.Copy
Table.Cell(Row:=3, Column:=5).Range.Select
Word.Selection.Collapse
Word.Selection.PasteAndFormat (wdTableOverwriteCells)
'Copy ppa
Worksheets("Prop").Range("L4:L" & C).Select
Selection.Copy
Table.Cell(Row:=3, Column:=6).Range.Select
Word.Selection.Collapse
Word.Selection.PasteAndFormat (wdTableOverwriteCells)
'Copy klbs
Worksheets("Prop").Range("M4:M" & C).Select
Selection.Copy
Table.Cell(Row:=3, Column:=7).Range.Select
Word.Selection.Collapse
Word.Selection.PasteAndFormat (wdTableOverwriteCells)
'save and close document
Document.Save
Document.Close
Word.Quit
Set Table = Nothing
Set Document = Nothing
Set Word = Nothing
End Sub

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)
:-)