Naming the non-empty cells of a column as the previous column's values - vba

So what I want is a button that when pressed will automatically name the right hand column cells the left hand column values, my code at the moment looks something like this,
Private Sub CommandButton1_Click()
Range("F3").Name = Range("E3")
Range("F4").Name = Range("E4")
Range("F5").Name = Range("E5")
Range("F6").Name = Range("E6")
End Sub
I'm new to using VBA and have looked around a little but couldn't find what I wanted to achieve. Just want a simple solution which can automatically do what my code already does without having to be specific about cell rows.
I imagine that there will be either a while or for loop to repeat over many rows and an if statement for the code not running if a cell is empty.
Basically I want the command to run something like below but don't quite know how to write it in excel VBA myself.
for j=3:100
if F(j) = non empty
F(j).name = E(j)
else end
next j
end
Image below shows the end result :

From your sample image this looks like it should work.
Option Explicit
Sub name_eff()
Dim rw As Long
With Worksheets("Sheet6")
For rw = 2 To Application.Min(.Cells(.Rows.Count, "E").End(xlUp).Row, _
.Cells(.Rows.Count, "F").End(xlUp).Row)
If Application.CountA(.Cells(rw, "E").Resize(1, 2)) = 2 Then _
.Cells(rw, "F").Name = .Cells(rw, "E").Text
Next rw
End With
End Sub

Related

How to integrate a MAX and IF statement into a FOR loop in VBA?

Trying to include an if statement into the MAX function and create a FOR loop in VBA.
What I want the code to do is to return the MAX value from column B into a new column when the value in column A equals the value in column I. I also have more than 1,000 rows in the data set and so I need a loop.
Here is a screenshot of data set of the data set I'm working with:
When I execute the following code (max_no_loop) on my data set, I get the output that I am looking for. However, I want to loop over 1,000 rows and so I need I2 to be changing with each step of the integration.
Sub max_no_loop()
Range("K2").FormulaArray = "=MAX(IF(A:A=I2,B:B))"
End Sub
After thinking about it, I came up with the function below(max_loop) where I changed I2 to Cells(i, 9), however, when I run the function on my data, I get name errors (#NAME?) and don't get the desired outcome.
Sub max_loop():
Dim i As Integer
For i = 2 To 11
Cells(i, 11).FormulaArray = "=MAX(IF(A:A=Cells(i, 9),B:B))"
Next i
End Sub
Why am I unable to make the function work when I integrate it into a for loop?
You need to pull out the variable part completely like below:
Sub max_loop():
Dim i As Integer
For i = 2 To 11
Cells(i, 11).FormulaArray = "=MAX(IF(A:A=" & Cells(i, 9).Address & ",B:B))"
Next i
End Sub
You need to take your variable i outside the " of the formula.
Try the code below:
Sub max_loop():
Dim i As Integer
For i = 2 To 11
Cells(i, 11).FormulaArray = "=MAX(IF(A:A=Cells(" & i & ", 9),B:B))"
Next i
End Sub

VBA Excel: Show visible cells in listbox only

I have the below mentioned code, I am trying to load filtered cells only into the listbox but I don't know why the below mentioned code is not functional.
Legend:
PatternSearchButton is a button
PatternTextBox is a textbox by which the user enters a value Which the Sheet will filter.
WsLookup is a function which selects the sheet (completely functional)
Private Sub PatternSearchButton_Click()
Dim PatternInput As String, PatternCounter As Double, WsSelector As Worksheet
PatternInput = PatternTextBox.Value
Set WsSelector = WsLookup(GSMListType.Value)
WsSelector.Range("F:F").AutoFilter Field:=1, Criteria1:=PatternInput
PatternCounter = Application.WorksheetFunction.Subtotal(4, WsSelector.Range("F:F"))
With AvailableNumberList
.Clear
For k = 2 To PatternCounter + 1
.AddItem WsSelector.Range("A" & k).SpecialCells(xlCellTypeVisible).Value
Next k
End With
End Sub
You're are using PatternCounter as the upper limit in your For .. Next but this is being set using the MAX (e.g. 4) subfunction of SUBTOTAL. This might work on sequential numbers in an unfiltered list but it is unlikely to be accurate in a filtered list. Using the COUNT (2/102) or COUNTA (3/103) subfunction might be more appropriate.
You were using SUBTOTAL(4, ...) so I would assume that you are dealing with numbers. Use a straight count on numbers on visible cells in column F and modify the remainder of the code to resemble this.
PatternCounter = Application.WorksheetFunction.Subtotal(2, WsSelector.Range("F:F"))
With WsSelector.cells(1,1).currentregion.offset(1,0).SpecialCells(xlCellTypeVisible)
AvailableNumberList.Clear
For k = 1 To PatternCounter
AvailableNumberList.AddItem .cells(k, 1).Value
Next k
End With
The problem might stem from the fact that you add to the list box the value of a special cell that might not exist if the cell is hidden.
Try for the body of the For loop:
' ... previous code '
If Not WsSelector.Rows(k).EntireRow.Hidden Then
.AddItem WsSelector.Cells(k, 1).Value
End If
' rest of the code ... '
Also, make sure that AvailableNumberList points to the correct object in your code.

Referencing Multiple Sheets with large sets of Data

I am fairly new to VBA and having some general obstacles with basic syntax. I am using the below code to trim leading spaces and color code an ActiveSheet I am currently working on.
I have another Worksheet called "Country" that I would like to apply the same logic to the current sheet I am using. I am also having difficulties using the most efficient code to find any cells with values of "AcctTotal" , " CurrTotal" and " BravoTotal" (there are about 14,000 rows of data). I am currently highlighting the whole spreadsheet and utilizing "UsedRange" to find these cells.
To sum it up:
I would like to trim leading spaces and color code any values of "AcctTotal" , " CurrTotal" and " BravoTotal" in two worksheets: "Currency" and "Country"
Sub ColorCodeCurrency()
Dim r As Range
For Each r In Selection
If r.Value = " AcctTotal" Then
r.Value = LTrim(r.Value)
Intersect(r.EntireRow, ActiveSheet.UsedRange).Interior.ColorIndex = 15
End If
Next r
Dim s As Range
For Each s In Selection
If s.Value = " CurrTotal" Then
s.Value = LTrim(s.Value)
Intersect(s.EntireRow, ActiveSheet.UsedRange).Interior.ColorIndex = 40
End If
Next s
Dim t As Range
For Each t In Selection
If t.Value = " BravoTotal" Then
t.Value = LTrim(t.Value)
Intersect(t.EntireRow, ActiveSheet.UsedRange).Interior.ColorIndex = 35
End If
Next t
End Sub
Most of the problem is that you're doing the same thing three times. The 'For Each' statement is going through every cell three times. If you joined it into
for each r in selection
if r.value ="AcctTotal" then
'do something
elseif r.value = "CurrTotal" then
'do something else
elseif r.value = "BravoTotal" then
'do the third thing
end if
In addition to what Maudise said, when you refer to your data, you can use syntax like:
Sheets("Country").Range("A1:E14000")
If it's possible to make changes to your source data, you may find it helpful to format it as a table for easy reference. Use the Name Manager to give the table a useful name. Then, you can say something like:
For Each r In Sheets("Country").Range("CountryTable")
You could try this way:
Public Sub ColorCode ()
Dim i As Integer, j As Integer, m As Integer, n As Integer
i = Range("A:A").End(xlDown).Row
j = Cells.End(xlToRight).Column
For m = 1 To i
For n = 1 To j
If Cells(m, n).Value < 50 Then
Cells(m, n).Interior.ColorIndex = 13
End If
Next n
Next m
End Sub
One solution is to call this code placed in a module into "This workbook" in "Private Sub Workbook_Open()".

Copy cells in a row to another sheet considering a unique reference number

I an trying to extract data from sheet "Record" by matching an entered reference number in sheet "Form" with those numbers in column B of "Record." I was able to come up with the VB code below through command button click. However, it will only return a single value from sheet "Record" column i and coding for each will really be time consuming.
Private Sub CommandButton1_Click()
With Application.WorksheetFunction
Sheets("Form").Range("b:b") = _
.Index(Sheets("Record").Range("h:h"), .Match(Sheets("Form").Range("i13"), Sheets("Record").Range("b:b"), 0), 1)
End With
End Sub
I'm wondering if is it possible to copy values from sheet "Record" columns H-Q to sheet "Form" columns B-K if the reference number in cell I13 of sheet "Form" matches any value on column B of sheet "Record?" Because what i encounter most of the time is returning the entire row.
I would really appreciate any help. Thanks
It might be brute force, but I think the best way is to loop through the data like this:
'Find the last row of data
Public Function Get_Last_Row_Find(ByVal rngToCheck As Range) As Long
Dim rngLast As Range
Set rngLast = rngToCheck.Find(what:="*", searchorder:=xlByRows, SearchDirection:=xlPrevious)
If rngLast Is Nothing Then
Get_Last_Row_Find = rngToCheck.Row
Else
Get_Last_Row_Find = rngLast.Row
End If
If Get_Last_Row_Find <= 1 Then
Get_Last_Row_Find = 2
End If
End Function
Public Sub CommandButton1_Click
x = Get_Last_Row_Find(Sheets("Record").Range("B:B")
for i = 1 to x
if Sheets("Form").Range("I13").Value = Sheets("Record").Range("B:B").Offset(i-1,0).Value then 'match
Worksheets("Record").Range("H"&i&":Q"&i).Copy _
destination:=Worksheets("Form").Range("B"&i&":K"&i)
next i
Note the two methods of "offsetting": you can use the .Offset method or you can use a variable and concatenate it within the Range("") text.
Code not tested.

VBA code to hide a number of fixed discrete rows across a few worksheets

I'm for a solution to part of a macro I'm writing that will hide certain (fixed position) rows across a few different sheets. I currently have:
Sheets(Sheet1).Range("5:20").EntireRow.Hidden = True
To hide rows 5-20 in Sheet1. I also would like to hide (for arguements sake), row 6, row 21, and rows 35-38 in Sheet2 - I could do this by repeating the above line of code 3 more times; but am sure there's a better way of doing this, just as a learning exercise.
Any help much appreciated :)
Chris
Specify a Union of some ranges as follows
With Sheet1
Union(.Range("1:5"), .Rows(7), .Range("A10"), .Cells(12, 1)).EntireRow.Hidden = True
End With
Here is a try:
Sub hideMultiple()
Dim r As Range
Set r = Union(Range("A1"), Range("A3"))
r.EntireRow.Hidden = True
End Sub
But you cannot Union range from several worksheets, so you would have to loop over each worksheet argument.
This is a crude solution: no validation, no unhiding of existing hidden rows, no check that I have a sheet name as first parameter, etc. But it demonstrates a technique that I often find useful.
I load an array with a string of parameters relevant to my current problem and code a simple loop to implement them. Look up the sub and function declarations and read the section on ParamArrays for a variation on this approach.
Option Explicit
Sub HideColumns()
Dim InxPL As Integer
Dim ParamCrnt As String
Dim ParamList() As Variant
Dim SheetNameCrnt As String
ParamList = Array("Sheet1", 1, "5:6", "Sheet2", 9, "27:35")
SheetNameCrnt = ""
For InxPL = LBound(ParamList) To UBound(ParamList)
ParamCrnt = ParamList(InxPL)
If InStr(ParamCrnt, ":") <> 0 Then
' Row range
Sheets(SheetNameCrnt).Range(ParamCrnt).EntireRow.Hidden = True
ElseIf IsNumeric(ParamCrnt) Then
' Single Row
Sheets(SheetNameCrnt).Range(ParamCrnt & ":" & _
ParamCrnt).EntireRow.Hidden = True
Else
' Assume Sheet name
SheetNameCrnt = ParamCrnt
End If
Next
End Sub