1 Attachment(s)
Search multiple ranges for two specific above values and modify an offset
I'm currently creating an inventory list for several characters in a game. I'm trying to create an entry form above the inventory list that will search the list for if a character by that name is already carrying that item. If they are, it should add 1 to the Quantity Column. If not, it should add the data entered to the bottom of the list.
Example in context of the image below:
It should be testing cells A9 & B9 to find a match below them. So if the word spellbook is in B9 next to Adrys, it should find Adrys in A20 and Spellbook in B20, then change the quantity value in F20 to 2 by adding 1 to the existing 1. If it fails to find a match for both of those values (Adrys & Spellbook), it should add those value to the A & B cells at the very bottom of the list.
Attachment 23547
I have been trying several different formulas, but I can never seem to get it (I'm quite new to this and only have a limited understanding. Don't even completely understand what my current formulas do).
My attempted formulas so far that haven't even seemed to be able to create anything, including performing things like Debug.Print on a success, so I'm kinda stumped. Each formula is listed below in order of length. In addition, while some seem like they would return correct values, I don't know how to make them select that cell and then change a value in an offset cell. Any help would be appreciated.
Code:
Sub Test4()
With Sheets("Inventories").Range(Cells(1, 12), Cells(1, 314))
Dim Results As Range
Dim x As Long
Dim y As Long
Set Results = Cells.Find(What = "A9")
x = Results.Row
y = Results.Column
End With
Debug.Print x, y
Debug.Print Results
End Sub
Code:
Sub Test5()
Dim cl As Range
With Worksheets("Inventories").Cells
Set cl = .Find(Range("A9"), After:=.Range("A11"), LookIn:=xlValues)
If Not cl Is Nothing Then
cl.Select
End If
End With
End Sub
Code:
Sub Test2()
Dim lr As Long
Dim i As Integer
lr = Worksheets("Inventories").Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To lr
If UCase(Worksheets("Inventories").Cells(1, 3).Value) = UCase(Worksheets("Inventories").Cells(i, 1).Value) Then
MsgBox "No matching value found"
'Sheet2.Cells(14, 5).Value = Sheet1.Cells(i, 1).Offset(, 5).Value
End If
Next i
End Sub
Code:
Sub Test3()
Dim nameCell As Range
Dim offsetCell As Range
With Sheets("Inventories").Range("A12:A314")
Set nameCell = Range("A12:A314").Cells.Find(What:=Adrys)
Set offsetCell = nameCell.Offset(0, 5)
' Now, your offsetCell has been created as a range, so go forth young padawan!
End With
For Each cell In offsetCell
If IsNumeric(cell.Value) Then
If cell.Value > 0 Then
cell.Value = cell.Value + 1
End If
Else
MsgBox "Cell " & cell.Address(0, 0) & " does not have a number"
Exit Sub
End If
Next
Debug.Print nameCell, offsetCell
End Sub
Code:
Sub Comparestwocolumns()
Dim i As Long
Dim j As Long
Dim lastrow As Long
Dim ws As Worksheet
Set ws = Sheets("Inventories")
Set ws2 = Sheets("Inventories")
For i = 9 To 9
If IsEmpty(ws.Range("A" & i)) Then
Exit For
End If
For j = 12 To 50000
If IsEmpty(ws2.Range("A" & j)) Then
Exit For
End If
If ws.Range("A" & i).Value = ws2.Range("A" & j).Value Then
If ws.Range("B" & i).Value = ws2.Range("B" & j).Value Then
Exit For
End If
End If
Next j
Next i
MsgBox ("Finished ")
End Sub
Sub Other()
Application.ScreenUpdating = False
'Declare variables
Dim var As Variant, iSheet As Integer, iRow As Long, iRowL As Long, bln As Boolean, dar As Range
'Set up the count as the number of filled rows in the first column of Sheet1.
iRowL = Cells(Rows.Count, 126).End(xlUp).Row
'Cycle through all the cells in that column:
For iRow = 1 To iRowL
'For every cell that is not empty, search through the first column in each worksheet in the
'workbook for a value that matches that cell value.
If Not IsEmpty(Cells(iRow, q)) Then
For iSheet = ActiveSheet.Index + 1 To Worksheets.Count
bln = False
var = Application.Match(Cells(iRow, 2).Value, Worksheets(iSheet).Columns(8), 0)
'If you find a matching value, indicate success by setting bln to true and exit the loop;
'otherwise, continue searching until you reach the end of the workbook.
If Not IsError(var) Then
bln = True
Exit For
End If
Next iSheet
End If
'If you do not find a matching value, do not bold the value in the original list;
'if you do find a value, bold it.
If bln = False Then
Cells(iRow, 2).Font.Bold = False
Else
Cells(iRow, 2).Font.Bold = True
Range("K2:K10000").NumberFormat = "000000000000"
Range(Cells(iRow, 1), Cells(iRow, 34)).Offset(3500, 0) = Range(Cells(iRow, 1), Cells(iRow, 34)).Value
End If
Next iRow
Application.ScreenUpdating = True
End Sub
