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.
Related
I've got an Excel file with N rows and M columns. Usually data are organized one per row, but it can happens that a data occupy more than a row. In this case how can I express that the second (or next) row has to refer to the first row?
In this example, AP.01 has got 5 rows of description, so how can I say that the other 4 rows refer also to the first code?
EDIT once that I did the association I have to export my Excel file into an Access DB. So I want to see the tables with the correct data.
If I have only one row for the description I wrote this code and it works:
If grid(r, 3).Text.Length > 255 Then
code.Description = grid(r, 3).Text.ToString.Substring(0, 252) + "..."
Else
code.Description = grid(r, 3).Text.ToString
End If
Instead if I have more than one row for the description I wrote this code and it doesn't work:
Do While grid(r, 1).ToString = ""
If grid(r, 1).ToString = "" And grid(r, 3).ToString IsNot Nothing Then
Dim s As String
s = grid(r, 3).ToString
code.Description = grid((r - 1), 3).ToString & s
End If
Loop
If it is a one-off, try the below. This will basically put a formula in every cell that refers to the cell immediately above it:
Select column A (from top until bottom of list (row N)
Press ctrl + g to open the GoTo dialogue
Press Special
Select Blanks from the radio buttons
The above will select all the blank cells in column A. Now enter = and press up arrow. Enter the formula by holding down ctrl while pressing enter. That will enter the same formula in every cell.
Try
Sub Demo()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet3") 'change Sheet3 to your data sheet
With .Range("A:A").SpecialCells(xlCellTypeBlanks)
.FormulaR1C1 = "=R[-1]C"
.Value = .Value
End With
End Sub
From your question I Guess that, you must be define a variable for last column Value. and check the value in respective column, if it is empty then use column value if not empty then take current value as last value.
'Dim LastValue as string
LastValue = sheet("SheetName").cells(i,"Column Name").value
for i = 2 to LastRow '>>>> here i am assume you run code in for loop from row to
'to last count row(LastRow as variable)
'Put your sheet name at "SheetName" and column index (like "A","B","C"...) at "Column Name"
if sheet("SheetName").cells(i,"Column Name").value <>"" then
LastValue = sheet("SheetName").cells(i,"Column Name").value
end if
'(Do your stuff using LastValue , you may generate lastvalue 1, lastvalue2 ..etc)
next'for loop end here
I am new in VBA and learning on my own. I was able to build a code that searches for a value (previously define as "Number") on all sheets and for those sheets that have the specific value in an specific cell it will copy a range from the sheet and then paste it in a new worksheet. It is worth saying that I did not use copy and paste (see code below). The code works just fine, but I would like the new sheet to keep the same formatting as the source. I have tried a couple of things, but the stuff that works means I have to use Copy/Paste type coding, which later in the code gives me problems since it changes the ActiveSheet. Other attempts do not work. In addition I would like to have a fix column width for the ranges that are paste into the new sheet.
A piece of the code in question is below. FYI = the variable Number is defined earlier in the code. Also, earlier in the code I create the new sheet.
My Questions:
Foe the code below, is there a way to keep the formatting from the source, without having to use "copy" and "paste" type coding.
To the code below, can I somehow fix the width of the columns where the new staff are going to be paste?
If you have a better, more elegant way to write the code, I would appreciate it.
For k = 1 To wscount - 1
If Worksheets(k).Range("F2").Value = Number Then
j = j + 1
Worksheets(wscount + 1).Range(Cells(1, 1 + j), Cells(100, 1 + j)).Value = Worksheets(k).Range("F1:F100").Value
End If
Next
You can assign property value of the source cell to target cell just like what you do with value property.
Option Explicit
Public Sub CopyValueAndFormat()
For k = 1 To wscount - 1
If Worksheets(k).Range("F2").Value = Number Then
j = j + 1
Worksheets(wscount + 1).Range(Cells(1, 1 + j), Cells(100, 1 + j)).Value = Worksheets(k).Range("F1:F100").Value
'call setFormat method
setFormat Worksheets(k).Range("F1:F100"), Worksheets(wscount + 1).Range(Cells(1, 1 + j), Cells(100, 1 + j))
End If
Next
End Sub
Private Sub setFormat(source As Range, target As Range)
'set target format equal to source format
With target
.Value = source.Value
.Interior.Color = source.Interior.Color
.Font.FontStyle = source.Font.FontStyle
'add others property to format
'call AutoFit method to set column width
.EntireColumn.AutoFit
End With
End Sub
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
I have a user form that asks for a column reference to be entered into a TextBox. I am trying to make it so that the number replaces the letter in the code. I am using the Cells(a,b) format to do this. Which is why I need the number to replace the letter.
Worksheets("AIO").Cells(X, TextBox3).Value = Worksheets("FDSA").Cells(Y, TextBox4).Value
Hence in the previous code when: x=2, TextBox3.Value=A, y=4, and TextBox4.Value=AA
The code will work as
Worksheets("AIO").Cells(2, 1).Value = Worksheets("FDSA").Cells(4, 27).Value
The only thing I can think of making is a huge if statement were I code something similar like this:
If textbox3.value ="A" then
textbox3.value=1
elseif textbox3.value=E then
textbox3.value=5
.......
.......
textbox3.value=AD then
textbox3.value=30
End If
If you want to keep it uncomplicated, .Cells can use the column string instead of number
Sub test()
'From sheet module
Debug.Print Me.Cells(1, 1).Address 'prints $A$1
Debug.Print Me.Cells(1, "A").Address 'also prints $A$1
End Sub
You might have to validate that it's a valid column ID but you probably need to do that even converting it to a number.
On way to get a column number from a character string:
Sub ColumnNumber()
Dim s As String
Dim L As Long
s = "AB"
L = Cells(1, s).Column
MsgBox L
End Sub
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.