I have a problem and can't seem to solve it. I spend hours to try and fix it, but I can't seem to get passed the errors. Probably it is really simple for you to fix.
If you can help me, that would be amazing. I need a VBA-code to replace value X (cell found with vlookup) with a value in a different worksheet.
In the sheet: Voorraadmutatie doorvoeren I have a value in cell D4 that corresponds with a location in the sheet Voorraadbeheer stelling(en) (see images).
The value in cell D16 is the new stock so the stock in the database needs to change after activating the macro. However, to find the right cell to change I need to vlookup the right row/cell.
Sheet voorraadmutatie doorvoeren
Sheet Voorraadbeheer stelling(en)
If you could help me, that would be amazing. I have tried many things but I am not trained in using VBA. I keep getting errors and can't seem to solve it by browsing on the internet.
Thank you in advance.
I hope this example can help
Sub vLookup()
Dim SearchedValue, oldStock, newStock As Variant
Dim MyMatrix As Range
Dim No_index_col As Single
Dim ApproximateValue As Boolean
Dim n As Long
' SearchedValue = "D002"
SearchedValue = ThisWorkbook.Sheets("voorraadmutatie doorvoeren").Range("D4")
' new stock in D16
newStock = ThisWorkbook.Sheets("voorraadmutatie doorvoeren").Range("D16")
Set MyMatrix = ThisWorkbook.Sheets("voorraadbeheer stelling(en)").Range("A:C")
No_index_col = 3
ApproximateValue = False
' display the previous vlue of the stock
oldStock = Application.WorksheetFunction.vLookup(SearchedValue, MyMatrix, No_index_col, ApproximateValue)
n = 2 '2nd ligne of the matrix
Do While Not (IsEmpty(ThisWorkbook.Application.Sheets("voorraadbeheer stelling(en)").Cells(n, 1)))
If ThisWorkbook.Application.Sheets("voorraadbeheer stelling(en)").Cells(n, 1) = SearchedValue Then
ThisWorkbook.Application.Sheets("voorraadbeheer stelling(en)").Cells(n, 3) = ThisWorkbook.Sheets("voorraadmutatie doorvoeren").Range("D16").Value
End If
' next line
n = n + 1
Loop
End Sub
Related
I am still new to Visual Basic, and would like to create a macro that essentially fills in empty cells with a value (integer) of zero, while leaving existing cells in the range as they were (if not empty). My code currently is this:
Sub FillEmptyCellsWithZeros()
'this should fill empty cells with a 0 value for the range selected
Dim cell As Object
Dim y As Integer
y = 0
For Each cell In Selection
If y = Empty Then
Selection.Value = 0
ElseIf y <> Empty Then
Selection.Value = ActiveCell.Value
End If
Next cell
End Sub
I know that most likely my loop isn't doing anything in this piece of code, but I cannot seem to get the result and this code was the closest I got.
Any help would be appreciated.
Thank you
Not to take anything away from Scott's answer, but if you're interested in a non-looping answer, you can try something like:
Selection.SpecialCells(xlCellTypeBlanks).Value = 0
this may cause problems if you have a large selection with a lot of discontinuous ranges, but it should be pretty reliable.
Also, if you have a formula that returns a blank (e.g.):
=IF(E16="","")
it will not consider those as blank (meaning they will still "appear" blank after running the code), so your mileage may very.
You are over thinking a little:
Sub FillEmptyCellsWithZeros()
'this should fill empty cells with a 0 value for the range selected
Dim cell As Object
Dim y As Integer
y = 0
For Each cell In Selection
If cell = "" Then
cell = y
End If
Next cell
End Sub
How do i write the following code as a loop. I want to copy values from a table in sheet 4 in a row from range (b:17:L17"). is there a more efficient way to do it with loops ?
ActiveSheet.Range("B17").Value = Sheets(4).Range("G8")
ActiveSheet.Range("C17").Value = Sheets(4).Range("G9")
ActiveSheet.Range("D17").Value = Sheets(4).Range("G10")
ActiveSheet.Range("E17").Value = Sheets(4).Range("G11")
ActiveSheet.Range("F17").Value = Sheets(4).Range("G12")
ActiveSheet.Range("G17").Value = Sheets(4).Range("G13")
ActiveSheet.Range("H17").Value = Sheets(4).Range("G14")
ActiveSheet.Range("I17").Value = Sheets(4).Range("G15")
ActiveSheet.Range("J17").Value = Sheets(4).Range("G16")
ActiveSheet.Range("K17").Value = Sheets(4).Range("G17")
ActiveSheet.Range("L17").Value = Sheets(4).Range("G18")
Yes, there is:
ActiveSheet.Range("B17:L17").Value = Application.Transpose(Sheets(4).Range("G8:G18").Value)
You can, using something like this (VB.Net, but may copy easily to VBA):
Dim cell as Integer, c as Integer
cell = 8
For c = 66 To 76
ActiveSheet.Range(Chr(c) & "17").Value = Sheets(4).Range("G" & cell)
cell = cell + 1
Next
The Chr() function gets the character associated with the character code (66-76), and then this value is concatenated with the string "17" to form a complete cell name ("B17", "C17", ...)
I am also incrementing the cell number for G at the same time.
Use this if you really want to use a loop - but there could be better ways, like the answer given by #A.S.H
Solution explanation:
Establish your rules! What is changing in the range for active sheet? The column is going to grow as the for/to cycle does! So, we should sum that to it. What is the another thing that is going to increment? The Range in the other side of the '=' so, by setting an algorithm, we may say that the row is const in the Activesheet range and the column is the on variable on the other side.
Solution:
Sub Test()
Const TotalInteractions As Long = 11
Dim CounterInteractions As Long
For CounterInteractions = 1 To TotalInteractions
'where 1 is column A so when it starts the cycle would be B,C and so on
'where 7 is the row to start so when it begins it would became 8,9 and so on for column G
ActiveSheet.Cells(17, 1 + CounterInteractions).Value = Sheets(4).Cells(7 + CounterInteractions, 7)
Next CounterInteractions
End Sub
This is probably your most efficient solution in a with statement:
Sub LoopExample()
Sheets("Sheet4").Range("G8:G18").Copy
Sheets("Sheet2").Range("B17").PasteSpecial xlPasteValues, Transpose:=True
End Sub
I have a large data set which I need to manipulate and create individual worksheets. Within column B all cells which are coloured Green I would like to make a new worksheet for. Please see screen shot.
For example I would like to create worksheets titled "Shopping" & "Retail". Once the worksheet is created, I would then like to copy all the data between the "worksheet title" (Green Cells) from columns ("B:C") & ("AI:BH") Please see screen shot below for expected output;
The code I have so far is below as you can see it is not complete as I do not know how I would go about extracting data between the "Green Cells".
Sub wrksheetadd()
Dim r As Range
Dim i As Long
Dim LR As Long
Worksheets("RING Phased").Select
LR = Range("B65536").End(xlUp).Row
Set r = Range("B12:B" & (LR))
For i = r.Rows.Count To 1 Step -1
With r.Cells(i, 1)
If .DisplayFormat.Interior.ColorIndex = 35 Then
MsgBox i
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = Cells (i,1).Value
Worksheets("RING Phased").Select
End If
End With
Next i
End Sub
Any help around this would be much appreciated.
Sorry for taking a while to get back to this, I've been somewhat busy the last few days, so I haven't had much time to be on StackOverflow.
Anyway, the way I'd go about this would be to store all the found values in an array, and then loop through that array in order to find the distance between them.
The following code works for me, using some very simplified data, but I think the principle is sound:
Option Explicit
Option Base 0
Sub wrksheetadd()
Dim r As Range, c As Range
Dim i As Long: i = 0
Dim cells_with_color() As Range: ReDim cells_with_color(1)
With Worksheets("RING Phased")
' Since it doesn't seem like the first cell you want to copy from is colored, hardcode that location here.
' This also saves us from having to test if the array is empty later.
Set cells_with_color(i) = .Range("B12")
i = i + 1
Set r = Range(.Range("B13"), .Range("B" & .Cells.Rows.Count).End(xlUp))
' Put all the cells with color in the defined range into the array
For Each c In r
If c.DisplayFormat.Interior.ColorIndex = 35 Then
If i > UBound(cells_with_color) Then
ReDim Preserve cells_with_color(UBound(cells_with_color) + 1)
End If
Set cells_with_color(i) = c
i = i + 1
End If
Next
' Loop through the array, and copy from the previous range value to the current one into a new worksheet
' Reset counter first, we start at 1, since the first range-value (0 in the array) is just the start of where we started checking from
' (Hmm, reusing variables may be bad practice >_>)
i = 1
While i <= UBound(cells_with_color)
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = cells_with_color(i).Value
' Set the range to copy - we could just do this in the copy-statement, but hopefully this makes it slightly easier to read
Set r = .Rows(CStr(cells_with_color(i - 1).Row) + 1 & ":" & CStr(cells_with_color(i).Row))
' Change the destination to whereever you want it on the new sheet. I think it has to be in column one, though, since we copy entire rows.
' If you want to refine it a bit, just change whatever you set r to in the previous statement.
r.Copy Destination:=Worksheets(CStr(cells_with_color(i).Value)).Range("A1")
i = i + 1
Wend
End With
End Sub
It probably lacks some error-checking which ought to be in there, but I'll leave that as an exercise to you to figure out. I believe it is functional. Good luck!
I would like to create a macro in excel that lets me increment the counts of a part whenever I press a command button.
Currently, my concept is to use vlookup to get the existing counts for that part using the following. However, it does not increment the actual counts value in the cell, which is what I want. I suspect it's cos vlookup is only used to return a value within the cell, but the cell is not activated in the process for actual increment. Can someone please advise how I can correct it? I'm still new to vba. Thanks!!! :)
E.g. Vlookup finds C1value in Cell A5 of Sheets("Location"). It will automatically increment the value in Cell C5 by 1.
Sub FindAddTools()
Dim C1Qnty As Double
C1value = Sheets("Issue").Range("D11")
Sheets("Location").Activate
C1Qnty = WorksheetFunction.VLookup(C1value, Range("A:D"), 3, False)
C1Qnty = C1Qnty + 1
End Sub
ADD ON: an add-on to my original question. I was wondering if it is possible to do the same for an entire range?
E.g. C1value is now a range of Sheets("Issue").Range("D11:D20"). I want to find all values within this range in Sheets("Location") and increment their corresponding counts in Column C.
Is there a way to do this without repeating the same procedure for all cells of the range?
Thanks! :)
Here's my shot at it. If the value isn't matched nothing happens:
Sub FindAddTools()
Dim RangeToMatch As Excel.Range
Dim cell As Excel.Range
Dim C1Value As Variant
Dim C1Row As Variant
Set RangeToMatch = Sheets("Issue").Range("D2:D11")
For Each cell In RangeToMatch
C1Value = cell.Value
With Sheets("Location")
C1Row = Application.Match(C1Value, .Range("A:A"), 0)
If Not IsError(C1Row) Then
.Range("C" & C1Row).Value = .Range("C" & C1Row).Value + 1
End If
End With
Next cell
End Sub
I edited it so that it cycles through a range of cells to match. That range is set to D2:D11 above.
Based on your comments, I think this should do it.
NB: you don't have to Activate worksheets to perform the functions referencing their cells/ranges.
Sub FindAddTools()
Dim shIssue as WOrksheet: Set shIssue = Sheets("Issue")
Dim shLoc as Worksheet: Set shLoc = Sheets("Location")
Dim allC1Values as Range
Dim C1Value as Variant
Dim C1Qnty As Double
Dim foundRow as Long
Set allC1Values = shIssue.Range("D11:D100") '## Modify as needed.
For each C1Value in allC1Values.Cells
C1Qnty = WorksheetFunction.VLookup(C1value, shLoc.Range("A:D"), 3, False)
C1Qnty = C1Qnty + 1
foundRow = WorksheetFunction.Match(c1Value,shLoc.Range("A:A"),False)
shLoc.Range("C" & foundRow).Value = CqQnty
Next
End Sub
Be careful with this. You're immediately writing to the same cell you just "found" with the VLOOKUP function, so, obviously if you run this macro again, you're going to increment it again. But, this may be the desired functionality, if so, no problem.
NOTE: There is no error trapping for if C1Value is not found in the VLOOKUP or MATCH functions.
the line that is giving me trouble is ""Sheets(CStr(WS_M.Cells(n, START_C))).Cells(n, START_C).Paste""
this is supposed to find the tab name in column 3 and go to that tab and paste the tab name in that tab.
Const START_C = 3
Const MAX_TRAN = 1000
Const START_R = 2
Const MASTER = "MASTER"
Sub MOVEDATACORRECTLY()
Dim WS_M As Worksheet
Dim thisWB As Workbook
Set thisWB = ActiveWorkbook
Set WS_M = Worksheets(MASTER)
For M = START_R To (START_R + MAX_TRAN)
If WS_M.Cells(M, (START_C + 1)) = "" Then Exit For
Next M
M = M - 1
For n = START_R To M
WS_M.Cells(n, START_C).Copy
Sheets(CStr(WS_M.Cells(n, START_C))).Cells(n, START_C).Paste
Next n
End Sub
Try this instead:
For n = START_R To M
WS_M.Cells(n, START_C).Copy
Sheets(CStr(WS_M.Cells(n, START_C))).Cells(n, START_C).Select
ActiveSheet.Paste
Next n
If you look at the documentation for the Excel Range object, Paste is not in the list of members. There is PasteSpecial, however. I haven't experimented with that, but that might also work.
For copying a range of cells in Excel, using Copy method makes the VBA program easier to crash / or to give inpredictable results.
Suppose during the your procedure copies data from system clipboard and user was trying to store some other to system clipboard!
Not always, but from users this kind of mistake might happened.
So I always prefer to use a better approach, something like Swaping the range on the fly. Here's a small demonstration:
Public Sub Sample_Copy_without_Clipboard()
Dim dRange As Range, iRange As Range
Set iRange = Range("A1:B3")
Set dRange = Range("D1:E3")
dRange.Value = iRange.Value
End Sub
Note: This method works only with unformatted textual data. If not then either use Tim's suggestion or DanM's answer.