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
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 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
Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 5 years ago.
Improve this question
Please see image below. What I would like to do is copy the value in cell C3 into column B into rows 4-13. Then copy vehicle number in cell C16 into B17 and so on.
Basically this displays all the trips a vehicle has made and the data for different vehicles is separated by blank rows.
Please help.
Check image below:
given your data structure you could try this:
Option Explicit
Sub main()
Dim vehicleRng As Range, cell As Range
With Range("A2", Cells(Rows.count, 1).End(xlUp))
.AutoFilter field:=1, Criteria1:="VEHICLE"
Set vehicleRng = .Resize(.Rows.count - 1).Offset(1).SpecialCells(xlCellTypeVisible)
End With
ActiveSheet.AutoFilterMode = False
For Each cell In vehicleRng
With cell
Range(cell.Offset(1), cell.End(xlDown).Offset(-1)).Offset(, 1).Value = cell.Offset(, 2)
End With
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
I am trying to cut and past values from a range of cells on sheet 1 to the next available row on sheet 2. All guides and advice I've seen has been for copying and pasting and for same sheet.
Range on sheet 1 is E5-H5 to be cut, not copied, and then pasted to sheet 2, cells E7-H7 or the next available row below that as each time someone enters data I need sheet 2 to keep it.
Don't select. I post this answer more to help #KoderM16 improve their methods than to answer the original question:
Sub CutPaste()
ThisWorkbook.Sheets("Sheet1").Range("E5:H5").Copy
Sheets("Sheet2").Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).PasteSpecial
End Sub
Also this doesn't make sense as it returns true or false (will most likely always be true because it can in fact select that address):
Lastrow = Sheets("Sheet2").Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Select
You would want .row on the end instead of .select if you want to assign the row to Lastrow, you don't however then use lastrow.
With your code as it is, lastrow would most likely always be -1 as that is the value for True
The below code will copy your range and look for the 1st empty cell (from the bottom up) in column E, Sheet 2, to paste. Hope this helps.
Sub CutPaste()
Dim Lastrow As Long
ThisWorkbook.Sheets("Sheet1").Range("E5:H5").Copy
Lastrow = Sheets("Sheet2").Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial
End Sub
As you are new to Stack Overflow and probably vba as well, just try to adhere to the comment above by Peh. Your question, while not specifically, is easily googlable in parts. Also, if this answers your question, please tick it.