Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 5 years ago.
Improve this question
I have got two sheets, one with data like this:
For one person there can be couple of rows with answers.
And second sheet with this data:
Here one person had only one row with answers.
Based on the surnames from second table I want to search the person in first table and if the person is present copy the whole row to another sheet. So my final output table will looks like this:
My idea is that the algorithm should take the surname from table in Data 2 sheet on look for it in Data 1 sheet if is present then copy whole row into A3 Output sheet, next search the rest of Data 2 for another appearance. If blank cell then take another surname from Data 2 table and do it up to the point where in Data 2 table blank space is detected. But I have no idea how to translate it into VBA code.
Could anyone help with some clues? Or macro that I can use here?
I would be really thankful for any help.
Here's a VBA subroutine that I believe will do what you asked, not sure if it is what you want. This is assuming you already have a tab to receive the data to be copied; the tabs being used are MRWV1 = names to select, MRWV2 = Data sheet of rows to copy and MRWV3 = sheet to receive the copied data.
Sub MRWV()
'
' MRWV Macro
'
' Housekeeping
vFoundKt = 1
vSourceRows = 0
vDataRows = 0
' Select the sheet with the five rows with the names to select
Sheets("MRWV1").Select
vSourceRows = Cells(Rows.Count, 1).End(xlUp).Row
Sheets("MRWV2").Select
vDataRows = Cells(Rows.Count, 1).End(xlUp).Row
'Get names from source sheet
For iSource = 2 To vSourceRows
Sheets("MRWV1").Select
Range("A" & iSource).Select
vSourceName1 = ActiveCell.Value
Range("B" & iSource).Select
vSourceName2 = ActiveCell.Value
'Look through data sheet for matching names
For iData = 2 To vDataRows
Sheets("MRWV2").Select
Range("A" & iData).Select
vDataName1 = ActiveCell.Value
Range("B" & iData).Select
vDataName2 = ActiveCell.Value
If vSourceName1 = vDataName1 And vSourceName2 = vDataName2 Then
vFoundKt = vFoundKt + 1
Range("A" & iData & ":I" & iData).Select
Selection.Copy
Sheets("MRWV3").Select
Range("C" & vFoundKt).Select
Selection.PasteSpecial Paste:=xlPasteValues,Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
Next
Next
End Sub
Related
Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 4 years ago.
Improve this question
I would like to have VB code in excel. If cell "A1:A200 is blank then concananet cells B1:C1.
enter image description here
Sub FillColumnA()
Dim i As Long
For i = 1 To 200
If Cells(i, 1).Value = "" Then
Cells(i, 1).Value = Cells(i, 2).Value & Cells(i, 3).Value
End If
Next
End Sub
no loops
Sub FillColumnA()
With Range("A1:A" & Cells(Rows.Count, 2).End(xlUp).Row)
.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=CONCATENATE(RC2,RC3)"
.Value = .Value
End With
End Sub
Shift your data down 1 row and add headers. Set your data up as a table by selecting a populated cell in the range and pressing Ctrl+T. Then in column D2 put
=IF(ISBLANK(A2),CONCATENATE(B2,C2),"")
The table will autofill the rest of the columns with the formula.
If you simply press Ctrl+T without shifting your data and then don't select my table has headers, the data will be shifted for you.
Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 5 years ago.
Improve this question
Is it possible to have a VBA code check columns B,E,H,K,N from sheet1 for a number greater than 0, then copy and paste that cell, the one before and the one after in sheet2 in columns A,B and C?
Here is the code I've been using but it's taking the whole Row and that's not exactly what I want as it gives a lot of content that's unnecessary:
Sub Epicerie()
For Each Cell In Sheets("Liste").Range("B:B, E:E, H:H, K:K, N:N")
If Cell.Value > 0 Then
matchRow = Cell.Row
Rows(matchRow & ":" & matchRow).Select
Selection.Copy
Sheets("Listepret").Select
ActiveSheet.Rows(matchRow).Select
ActiveSheet.Paste
Sheets("Liste").Select
End If
Next
End Sub
I think you are after something like the code below:
Option Explicit
Sub Epicerie()
Dim Cell As Range
For Each Cell In Sheets("Liste").Range("B:B, E:E, H:H, K:K, N:N")
If Cell.Value > 0 Then
With Sheets("Listepret")
' copy paste in 1 line to the next empty row at Column "A"
Cell.Offset(, -1).Resize(1, 3).Copy Destination:=.Range("A" & .Cells(.Rows.Count, "A").End(xlUp).Row + 1)
End With
End If
Next
End Sub
Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 5 years ago.
Improve this question
I'd like to start by telling you that I spent at least 2 hours reading different questions/answers on Stackoverflow and random google search results. I couldn't find an answer to my specific problem although a lot of questions/answers dealt with similar problems.
Every week, I'm manually copying rows from an Excel sheet into another Excel sheet based on certain criteria. In one column, the value of the cells that interest me are "not done" and in a second column I'm looking for due date that is in the past, i.e. overdue items. If both criteria are met, I copy the entire row into a newly created sheet in another Excel file.
I know VBA basics and thought about making my life easier by writing a macro that copies the respective rows into another Excel file and a new sheet. However, I'm not able to write a rather complex macro yet :(
Can you please help me by explaining how to write two loops (of some sort) that first look through the first column (find cells where value is not X) and after that look for a date in the past in a second column and then copy the rows where these two criteria met? Is that even possible with VBA? I'm not asking for the whole macro because I like to figure out how to get the remaining code right, but these loops are very complicated for a beginner and I'd really appreciate some guidance here.
Thanks in advance for taking the time to read this wall of text.
Edit: After checking excel-easy (thanks #maxhob17 ) I managed to make some progress. Please see this code so you get an idea of my progress. This code gets all the relevant rows based on the first criterion (status = done) and copies them into a new sheet in the same Excel file.
Public Sub Copy_Relevant_Items()
Dim CurrentWorkbook As Workbook
Dim InputWS As Worksheet
Dim OutputWS As Worksheet
Set CurrentWorkbook = Workbooks(ActiveWorkbook.Name)
Set InputWS = CurrentWorkbook.Sheets("Overview")
Set OutputWS = CurrentWorkbook.Sheets("Relevant")
Dim criterion As String
criterion = "Done"
Dim cells As range, cell As range
'Find the last used row in a Column: column C in this example
With InputWS
LastRow = .cells(.rows.Count, "C").End(xlUp).row
End With
Set cells = range("C2:C" & LastRow)
'Copy all the relevant rows into another sheet
For Each cell In cells
If cell.Value <> criterion Then
cell.EntireRow.Copy Destination:=OutputWS.range("A" & rows.Count).End(xlUp).Offset(1)
End If
Next cell
End Sub
you could use AutoFilter()
assuming your database spans from column A to D and dates are in column D then you could code
Option Explicit
Public Sub Copy_Relevant_Items()
Dim InputWS As Worksheet, OutputWS As Worksheet
Dim criterion As String
Set InputWS = ActiveWorkbook.Sheets("Overview")
Set OutputWS = ActiveWorkbook.Sheets("Relevant")
criterion = "Done"
With InputWS
With .Range("A1:D" & .cells(.Rows.Count, 1).End(xlUp).Row) '<--| reference its columns A to C from row 1 down to column A last not empty row. Change A and D to your actual data limit columns index
MsgBox .Address
.AutoFilter Field:=3, Criteria1:="<>" & criterion '<--| filter column C cells with content different from 'Criterion'. change "3" to your actual relative position of "status" column inside your database
.AutoFilter Field:=4, Criteria1:="<" & CLng(Date) '<--| filter column D cells with content less than current date. change "4" to your actual relative position of "date" column inside your database
If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Copy Destination:=OutputWS.Range("A" & Rows.Count).End(xlUp).Offset(1) '<--| if any cell filtered other than headers then copy them to 'OutputWS'
End With
End With
End Sub
Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 6 years ago.
Improve this question
Hello I have a list of 65000 rows of stocks price for one column, and I would like to adapt it like in the second pic, anyone has any idea how to code it with vba ? Thank you!
Assuming that the data structure is always the same (12 months of data and 3 rows for data set id's). Change Sheet Name on Code Line 9 to suit your Sheet Name
Sub TRANSPOSE_DATA()
Dim lRow, i, x As Long
'------------------
With ThisWorkbook
'ADD OUTPUT WORKSHEET
.Sheets.Add After:=.Sheets(.Sheets.Count) 'add a sheet for output
.ActiveSheet.Name = "OUTPUT" 'sheet rename
'COPY DATA
With .Sheets("Hoja1") 'Change sheet name for yours
lRow = .Range("A1048576").End(xlUp).Row 'last row definition
.Range("A1:B15").Copy Destination:=ThisWorkbook.Sheets("OUTPUT").Range("A1") 'First dataset copy (including headers)
x = 3 'first iteration column definition
For i = 16 To lRow - 14
.Range("B" & i & ":B" & i + 14).Copy Destination:=ThisWorkbook.Sheets("OUTPUT").Cells(1, x) 'copy data from each iteration
x = x + 1 'transpose 1 column for next iteration
i = i + 14 'transpose 12 months plus header rows for next iteration
Next i
End With
End With
End Sub
Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 8 years ago.
Improve this question
I would really appreciate your help with building some macro logic. I've messed around modifying recorded macros in the past, but am not familiar enough with VBA to build something from scratch. I've looked over the many examples here as well (mindboggling!), but did not find anything close enough to what I need to do...
I know it probably only takes a few lines of code - which makes it even more frustrating. Can someone please put me on the right track?
I have a single workbook with two sheets. Sheet1 contains a long list (~25k rows, but variable) of product details. Column A has the product ID, then columns B through G hold specific details on each product. Sheet2 is similar, again with product ID in column A and (different) properties in columns B through E. Sheet2 is much smaller, at about 100 rows (also variable).
What I need to do is to loop through the products (rows) in Sheet2, find the corresponding Product ID in Sheet1, and copy/paste the product properties in Sheet1 (B through G) to Sheet2 (to the right of the existing properties, so starting at column F in my example) - effectively merging all product properties in Sheet2.
I would be very grateful if one of you wizzards can provide skeleton code for that....
Set the two ranges from your two sheets, loop through them and find matches in product id, then just copy the values from the first sheet into the second one. Also replace the ranges to match your conditions.
Sub search()
Dim cell As Range, rng As Range, rng2 As Range, cell1 As Range, n As Integer, m As Integer
Set rng = Sheet1.Range("A2:A9")
Set rng2 = Sheet2.Range("A2:A3")
n = 1
m = 1
For Each cell In rng
n = n + 1
For Each cell1 In rng2
m = m + 1
If cell.Value = cell1.Value Then
Sheets("Sheet2").Range("F" & m & ":J" & m).Value = Sheets("Sheet1").Range("B" & n & ":F" & n).Value
End If
Next cell1
m = 1
Next cell
End Sub