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 6 years ago.
Improve this question
Hi I am working on Excel vba i've a set of columns retrived from sql into excel using vba and i've to get the id of the particular retrived column value by referring another sheet. For example i've 2 sheets where sheet1 has rid,rname columns and sheet2 has sid,rid,date columns.whereas, The values retrived from sql to excel sheet2 has sid,rname,date values i want to replace rname value with rid value by referring corresponding rid in sheet1. How to do this using VBA code
Please consider all comments under your question for further posts.
Here is an answer nevertheless.
This works for two columns with the same amount of rows:
Sub stack()
Dim ws1, ws2 As Worksheet
Dim targetRng As Range
Dim i As Long
Set ws1 = Worksheets(1)
Set ws2 = Worksheets(2)
Set targetRng = ws2.Range(ws2.Cells(firstRow, columnID), ws2.Cells(lastRow, columnID))
i = firstRowSourceSheet
For Each cell In targetRng
cell.Value = ws1.Cells(i, columnIDSource)
i = i + 1
Next
End Sub
Fill in variables accordingly.
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 5 years ago.
Improve this question
I am new to VBA and would like to learn by creating expense database, How do I transferring and making monthly database?
If dashboard date is matching to Aug17 column A, move data from dashboard to Aug17 respective row. If possible, I would like it to search dashboard date to all worksheet and move data to respective row if matching found. Thanks in advance.
DashBoard
Aug17
Based on your response to my questions in the comments here's code that does what you asked. Notice that the final msgbox will never be encountered if the date is found. Hopefully you will be able to adjust this code to suit your needs once you understand it.
Sub test()
Dim r As Range, dashSh As Worksheet, dashR As Range, sh As Worksheet
Dim mo As String, yr As String
Set dashSh = Worksheets("Dashboard")
Set dashR = dashSh.Range("A5:J5")
mo = Application.WorksheetFunction.Text(dashR.Columns(1), "mmm")
yr = Application.WorksheetFunction.Text(dashR.Columns(1), "yy")
Set sh = Worksheets(mo & yr)
sh.Activate
Set r = sh.Range("A5")
While r <> ""
If r = dashR.Columns(1) Then
r.Select
dashR.Copy
sh.Paste
End
End If
Set r = r.Offset(1, 0)
Wend
MsgBox ("date not found")
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 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
Closed. This question does not meet Stack Overflow guidelines. It is not currently accepting answers.
Closed 8 years ago.
This question appears to be off-topic because it lacks sufficient information to diagnose the problem. Describe your problem in more detail or include a minimal example in the question itself.
Questions asking for code must demonstrate a minimal understanding of the problem being solved. Include attempted solutions, why they didn't work, and the expected results. See also: Stack Overflow question checklist
Improve this question
Let me give you a basic understanding of my what I'm trying to do. I have two workbooks: Master Workbook and Workbook A. Information in Workbook A will be inputted into the Master Workbook. In Workbook A, there is Column X with numbers between the ranges of 1 to 25. All I care about are values greater than 14.
Problem: How do I create a VBA function that looks at Column X (Row 1) to see if it is greater than 14? If it is then it copies the entire row and pastes it into the Master Workbook, else it moves onto Column X2. Also, after copying row 1 and pasting into Master Workbook, I also need it to go back to Workbook A and check the rest of Column X if it is greater 14.
Thank you so much in advance!
This code should do what you want:
Private Sub checkAndCopy()
Dim i As Integer
Dim lastRow As Integer
Dim foundItem As String
Dim j As Integer
Dim pasteTo As Range
Dim k As Integer
k = 0
lastRow = WorksheetFunction.CountA(Range("A:A"))
For i = 1 To lastRow
If Cells(i, 24).Value > 14 Then
k = k + 1
For j = 1 To 24
foundItem = Cells(i, j).Value
Set pasteTo = Workbook(yourWorkbook).Cells(k, j)
pasteTo.Value = foundItem
Next j
End If
Next i
End Sub
Note that it copies into the new workbook starting on Row 1. You can have it search for the next empty line and add to that by including:
k = Workbook(yourWorkbook).WorksheetFunction.CountA(Range("A:A")) + 1
I hope this helps!
Closed. This question does not meet Stack Overflow guidelines. It is not currently accepting answers.
Questions asking for code must demonstrate a minimal understanding of the problem being solved. Include attempted solutions, why they didn't work, and the expected results. See also: Stack Overflow question checklist
Closed 9 years ago.
Improve this question
I am currently doing some data entry for a spreadsheet which contains hundreds on entries and want to automate the process, I have a good idea of what I want it to do but have little experience with Excel or VBA.
The idea behind it is that I have a code in one column and in the next column there is another code which is unique to the value in the former column. To give an example:
So for every cell that contains 123, the column next to it will be "ABC".
The sort of solution I would like is a macro that will work its way down Column A, storing the value of each cell (or something of that effect) and then working its way down to check for values that match that stored one. If a match is found, the macro will then copy the code from column B, the cell that is next to the stored cell and copy it into the cell in column B, next to the match.
EXAMPLE:
It will store the "123" value in A, work its way down Column A to find other cells matching "123" and when it finds them copy "ABC" into the column B cells next to the matches.
Hope this is easy to understand and someone can help me with coming up with a solution, would make this whole process alot easier as the spreadsheet is growing by the day and manual input is taking far to much time
Give this macro a try:
Sub FillInTheBlanks()
Dim rA As Range
Dim rB As Range
Dim r As Range, rr As Range
Dim N As Long
Dim va As Variant
N = Cells(Rows.Count, "A").End(xlUp).Row
Set rA = Range("A1:A" & N)
Set rB = rA.Offset(0, 1).Cells.SpecialCells(xlCellTypeBlanks)
If rB Is Nothing Then Exit Sub
For Each r In rB
va = r.Offset(0, -1).Value
For Each rr In rA
If rr.Value = va And rr.Offset(0, 1) <> "" Then
r.Value = rr.Offset(0, 1).Value
End If
Next rr
Next r
End Sub