I have a long list of data on an excel table. This data includes detail information of each order in several rows. There is a column shows the status of each row. Also, I have a dashboard which just lists out the order names. I want the users to be able to see a short statistical info of each book as a comment or when they mouse over the cell, if possible or as a cell data. The info could be something like underneath sample in 3 or 4 row. (The number of items is the count of rows with the same status)
5 issued item
3 shortage items
2 Done items
X other
If you just give me the general idea it would be great.
I think I have to use a collection procedure, something like "scripting dictionary" but I have no experience using them. I know how to do that by putting a case statement after if clause inside a loop, but I am looking for a smarter way. you can find some pictures and a sample data below: sample pictures
For the record, I came to this answer from one of friends in MrExcel froum. Hope you find it usefull.
The just difference is, I was looking for a momentum reply just for an active cell, but this code, provide all the information for all the order names as a comment. but it is very easy to adjust!
Sub UpdateComments()
Dim c As Variant, strComment As String
Dim intISSUED As Integer, intSHORTAGE As Integer
Dim tblDATA As ListObject, tblDASH As ListObject
Set tblDATA = Application.Range("TBL.data").ListObject 'adjust Table Name
Set tblDASH = Application.Range("TBL.dash").ListObject 'adjust Table Name
For Each c In tblDASH.ListColumns("W/B").DataBodyRange
strComment = ""
intISSUED = Application.CountIfs(tblDATA.ListColumns("Work Book").DataBodyRange, c, tblDATA.ListColumns("Stage").DataBodyRange, "Issued")
strComment = strComment & Chr(10) & "Issued: " & intISSUED
intSHORTAGE = Application.CountIfs(tblDATA.ListColumns("Work Book").DataBodyRange, c,tblDATA.ListColumns("Stage").DataBodyRange, "Shortage")
strComment = strComment & Chr(10) & "Shortage: " & intSHORTAGE
' ADDITIONAL 'STAGES' HERE
' OR put 'stages' in array to condense code
With Sheets(tblDASH.Parent.Name).Range(c.Address)
If .Comment Is Nothing Then
.AddComment
.Comment.Visible = False
End If
.Comment.Text Text:=Mid(strComment, 2)
End With
Next c
End Sub
Related
Well I have done a lot of research and found a lot of relevant questions and answers but couldn't quite figure out how to cater that information to my specific need.
I am working on a project to create a macro that will correct mistakes and fill in information commonly found in product catalogs that I work with.
One thing I am trying to accomplish is to give the value "unassigned" to each blank cell in a row that is marked "Y" in column B.
I've found out how to change every cell in those particular rows and have it adjust dynamically to the number of rows. What I can't figure out is how to do the same for the number of columns. In my code below everything between columns B and S is included. Column B will always be in the same spot but column S will not always be the last column.
Dim tracked As String
Dim endCell As Range
Dim endRow As Long
Dim endColumn As Long
Dim start As Long
endRow = ActiveSheet.Range("D2").End(xlDown).Row
endColumn = ActiveSheet.Range("A1").End(xlToRight).Column
Let tracked = "B2:" & "B" & endRow
Set trackItem = ActiveSheet.Range(tracked)
For Each y In trackItem
If Left(y.Value, 1) = "Y" Then
'start = y.Row
'Set endCell = ActiveSheet.Cells(endColumn, start)
ActiveSheet.Range("B" & y.Row & ":" & "S" & endColumn).Value = "Unassigned"
End If
Next y
I included some code that I've left commented out so you can see what I've tried.
So, I can successfully change the value of all cells within that range but I need to know how to do it with a range where the number of columns will not always be the same. In addition, I want to select the blank cells only within this range and assign them a value. I imagine this will need to be done row by row as the correct criteria will not always be together.
I'm surprised more people don't use 'UsedRange' when there is a need to loop through all the cells that have data on a sheet. (Just yesterday someone was complaining that it takes too long to loop through all 17,179,869,184 cells on a worksheet...)
This example lists & counts the "used" range, and will easily adapt to your needs.
Sub List_Used_Cells()
Dim c As Range, x As Long
For Each c In ActiveSheet.UsedRange.Cells
Debug.Print c.Address & " ";
x = x + 1
Next c
Debug.Print
Debug.Print " -> " & x & " Cells in Range '" & ActiveSheet.UsedRange.Address & "' are considered 'used'."
End Sub
I am new to VBA and am trying to delete unwanted columns loaded from a .csv file. I am importing a large amount of data but then I ask the user what columns they want to keep going by "ID num.". There are a lot of columns with different ID no. and I want to ask the user what they want to keep and delete the rest.
The problem is I need to delete all the other columns the user didn't want but I still need to keep the first 6 columns and the last two columns as that is different information.
Here is what I have so far:
Sub Select()
'the below will take the users inputs
UserValue = InputBox("Give the ID no. to keep seperating with a comma e.g"12,13,14")
'the below will pass the user inputs to the example to split the values
Call Example(UserValue)
End Sub
Sub Example(UserValue)
TestColArray() = Split(UserValue, ",")
For Each TestCol In TestColArray()
' keep all the columns user wants the delete the rest except the first 6 columns and last 2
Next TestCol
End Sub
That is what I have so far, it is not much but the user could put in a lot of columns with different ID number in the input box the way the Excel sheet is laid out all the ID no.s are in row 2 and the first 6 and last 2 columns are blank of row 2 since the ID no. does not apply. I hope that helps.
try this (commented) code:
Option Explicit '<--| use this statament: at the cost of having to declare all used variable, your code will be much easier to debug and maintainable
Sub MySelect()
Dim UserValue As String
'the below will take the users inputs
UserValue = Application.InputBox("Give the ID no. to keep seperating with a comma e.g: ""12,13,14""", Type:=2) '<--| use Type:=2 to force a string input
'the below will pass the user inputs to the example to split the values
Example UserValue '<--| syntax 'Call Example(UserValue)' is old
End Sub
Sub Example(UserValue As String)
Dim TestCol As Variant
Dim cellsToKeep As String
Dim firstIDRng As Range, lastIDRng As Range, IDRng As Range, f As Range
Set firstIDRng = Range("A2").End(xlToRight) '<-- first ID cell
Set lastIDRng = Cells(2, Columns.Count).End(xlToLeft) '<-- last ID cell
Set IDRng = Range(firstIDRng, lastIDRng) '<--| IDs range
cellsToKeep = firstIDRng.Offset(, -6).Resize(, 6).Address(False, False) & "," '<--| initialize cells-to-keep addresses list with the first six blank cells at the left of first ID
For Each TestCol In Split(Replace(UserValue, " ", ""), ",") '<--| loop through passed ID's
Set f = IDRng.Find(what:=TestCol, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False) '<--| search for the current passed IDs range
If Not f Is Nothing Then cellsToKeep = cellsToKeep & f.Address(False, False) & "," '<--| if the current ID is found then update cells-to-keep addresses list
Next TestCol
cellsToKeep = cellsToKeep & lastIDRng.Offset(, 1).Resize(, 2).Address(False, False) '<--| finish cells-to-keep addresses list with the firts two blank cells at the right of last ID
Range(cellsToKeep).EntireColumn.Hidden = True '<-- hide columns-to-keep
ActiveSheet.UsedRange.EntireColumn.SpecialCells(xlCellTypeVisible).EntireColumn.Delete '<--| delete only visible rows
ActiveSheet.UsedRange.EntireColumn.Hidden = False '<-- unhide columns
End Sub
it's assumed to be working with currently active worksheet
A simple google search produces this. On the first page of results too. Perhaps this will suit your needs.
If the data set that needs to be deleted is really large (larger than the ranges you want to keep too.) Then perhaps only select the columns you want to have whilst you import the csv? This stackoverflow question shows how to import specific columns.
EDIT:
So from what I believe the OP is stating as the problem, there is a large csv file that is being imported into excel. After importing there is alot of redundant columns that should be deleted. My first thought would be to only import the needed data (columns) in the first place. This is possible via VBA by using the .TextToColumns method with the FieldInfo argument. As stated above, the stackoverflow question linked above provides a means of doing so.
If the selective importing is not an option, and you are still keen on making an inverse of the user selection. One option would be to create 2 ranges (one being the user selected Ranges and the second being the entire sheet), you could perform an intersect check between the two ranges and delete the range if there is no intersection present (ie. delete any cell that is not part of the users selection). This method is provided by the first link I supplied and is quite straight forward.
I'm currently trying to work with complex tables in Microsoft Word. My problem is, those tables have fused cells and rows, and I'm not sure of how many rows or columns i'll have.
Here is a (stupid) example how the kind of tables i'll have
I get my table thanks to a bookmark, and then proceed to stock the table in a Dim for easier access
Sub SetTable()
Dim tb as Table
Selection.GoTo What:=wdGoToBookmark, Name:="MyTable"
Selection.MoveDown
Set tb = Selection.Tables(1)
End Sub
Now, I'd use that table to write in several tables of a database.
Let's say, I have a table "Destinations", a table "Ways" and a table "Time"
I'm kinda blocked there.
With fused rows and columns, i cannot access a whole column or row. But as i don't know how many rows and columns i have (i could have, for example, 5 different ways for "Destination 1", or several distances in "Way 1")
I am a little lost on how i should try to work.
Cell(x,y).Row doesn't work because several rows are fused, and it is the same with Column, so we get errors extremely easily
I was thinking of putting tables in cells that might get an unknown number of rows/columns, a bit like this
The Problem with this method is that the person that'll write in the document won't be me. Meaning, if he has to create a table each time there is a new line/column that requires it, chance is that it'll become a problem quickly.
(I haven't found yet a method to put something in a given cell of a table at the creation of a new line, I'm also open on that point)
I was wondering if there are best practices to apply in this kind of case, and I am looking for advices too.
If you already had to treat something similar to this, how did you do?
Thanks in advance for your answers
Cordially,
Zawarudio
Note : The example of table here is insanely stupid, and even I don't even know what it's talking about. It was just to put informations in the tables, and have absolutely no link with what I'm trying to do.
If you were lost by the distances/times/whatever, sorry about that
I had some vacations so I didn't work on that question before now.
I just found a way that I felt was relevant, so I come here to share my answer
Note that I only worked on an unknown number of merged rows at the moment, so this answer will only be about that, though I believe it is the same. Also note that I'm on Word 2010. I don't know if rows/column behavior changed in 2013 or will change in the future. (well, obviously)
The big problem was that a merged row cell will only have a value of the first row of the merged row. Let's take a simple example
This table has 2 rows and 2 columns. We fused the rows of the 1st column.
table.Rows.Count will return 2, so will table.Columns.count.
table.cell(1,1).Range.text will return the content of the merged rows.
We would like table.cell(2,1).Range.text to return the value of the merged row, but VBA tells us here that this value doesn't exist.
There is no problem with table.cell(1,2).Range.text and table.cell(2,2).Range.text.
With values, that means that our table with merged rows is pretty equals to that
Where each empty cell would generate an error 5941.
How to resolve the problem?
Sub ReadAllRows()
Dim NbRows As Integer
Dim NbColumns As Integer
Dim i, j As Integer
Dim SplitStr() As String
Dim col1 as String
Dim col2 as String
Dim col3 as String
Dim col4 as String
'note : my table here is a public value that i get thanks to bookmarks
NbRows = table.Rows.count
NbColumns = table.Columns.count
For i = 3 To NbRows
'We put each value of each columns in a dim
'We do that to remember previously entered row value if the application encounters an error
'Because of merged rows, some cells on each row will not exist and return an error
'When the application encounters an error, it just proceeds to next column
'As previous existing value of this column was stocked in a Dim, we can get the full row at the end of the column loop
For j = 1 To NbColumns
On Error GoTo ErrorHandler
SplitStr = Split(table.Cell(i, j).Range.Text, Chr(13))
Select Case j
Case 1:
col1 = SplitStr(0)
Case 2:
col2 = SplitStr(0)
Case 3:
col3 = SplitStr(0)
Case 4:
col4 = SplitStr(0)
'ect...
End Select
NextRow:
Next j
'We have here all the values of the line
MsgBox "col1: " & col1 & Chr(10) & _
"col2: " & col2 & Chr(10) & _
"col3: " & col3 & Chr(10) & _
"col4: " & col4 & Chr(10)
Next i
'This Error handler will skip the whole Select Case and thus will proceed towards next cell
ErrorHandler:
If Err.Number = 5941 Then
Err.Clear
Resume NextRow
End If
End Sub
That way, when a cell doesn't exist, that mean the row if merged. Meaning we want the last known value of the row. Since we skip the whole select when row is unknown, the value of the Dim isn't changed while we do get right the value of not merged rows.
This isn't rocket science, but I first began with a simple On Error Resume Next, and with that, non-existing rows simply had the value of last existing row, so I also had to work on a function that would try to get the good value for each cell of each row...
Note that I did things the ugly way here, but you can use a one dimensionnal arrays to stock an entire row the way Word is supposed to understand it, or you can even get a two dimensionnal array stocking your whole table in it a way Word understands
Well, I hope it helps someone, someday!
Cordially,
Zawarudio
I think there must be an existing Q/A about this but I didn't find it using a quick search, so for now...
One thing you can do is iterate through the cells of the range of the table. Like this:
Sub iterTable()
Dim r As Range
Set r = ActiveDocument.Tables(1).Range
For i = 1 To r.Cells.Count
Debug.Print r.Cells(i).RowIndex, r.Cells(i).ColumnIndex, r.Cells(i).Range.Text
Next
End Sub
As long as you have predefined texts that will allow you to detect your "Destination" groups, that should be enough for you to make progress...
I am a complete novice in VBA and I'm in way over my head I think but the research necessitates it. I followed a great online tutorial series, which unfortunately didn't help me in solving 1 big problem: Data input.
My goal is to scrape patent data from google patents. To do so, it's pretty convenient that Google patents website is uniquely identified by the patent number. Thus what I want to achieve is the following:
Extract the patent number from a list in excel
Use that number to access the specific webpage
Extract application and publication year of patent, as well as patent number (as check)
Store all in a single excel sheet
Now, I can make 2,3, and 4 work but it's the loop that allows me to extract the patent numbers from excel and put them into my code that I am missing.
Here is the current code:
Private Sub CommandButton4_Click()
Dim obMF As Object
Dim patent As String
Dim grant_date As String
Dim app_date As String
Dim patent_number As String
patent_number = insert.Text ' insert.Text refers to a textbox in my interface
Call gotopat(patent_number, patent, app_date, grant_date)
found.Text = patent
grantdate.Text = grant_date
appdate.Text = app_date
output_row = 1 'Set the output row as 1 (this is where the title is)
Do
DoEvents
output_row = output_row + 1 'Increase output row with 1
Loop Until Sheets("bkcit").Range("B" & output_row) = ""
'Continue loop until that cell ~ Range is blank.
'Once a blank is found, we can put new data in there
'Store data into Worksheet "bkcit"
Sheets("bkcit").Range("B" & output_row) = patent
Sheets("bkcit").Range("C" & output_row) = grant_date
Sheets("bkcit").Range("D" & output_row) = app_date
In this code, found.Text, grantdate.Text, and appdate.Text are sourced from the scraping function which works perfectly. The important things about that function are:
Function gotopat(patent_number As String, patent As String, app_date As String, grant_date As String)
' A Bunch of other stuff
obMF.Navigate ("http://www.google.com/patents/US" & patent_number & "?")
'All the scraping code'
So, I want to replace the patent_number = insert.Text by a loop that looks in my excel sheet bkcit, column A and basically loops through all the unique patent numbers. I tried
input_row = 1
Do
DoEvents
input_row = input_row + 1
Range("C" & input_row) = patent_number
Loop Until Sheets("bkcit").Range("A" & input_row) = ""
But this seems to delete the first patent number in cell A2 and nothing more.
I'm thinking I'm pretty close to a working solution but your help would be fantastic, as always!
Thanks in advance
Simon
If I understand correctly, you have a column of patent numbers like this:
And you want to loop through each number and do something to it. Try this:
Sub loopPatents()
Dim patentNumber As Range
Dim patentRange As Range
Set patentRange = Worksheets(1).Range("A2:A10")
For Each patentNumber In patentRange
MsgBox ("Patent number: " & patentNumber)
'Do your stuff with the patent number here
Next patentNumber
End Sub
So i'm making a macro to do a bunch of things. one thing is find duplicates of cells in sheet1 from sheet2. given columnA in sheet 1, do any values in columnB on sheet2 match any of the values in columna sheet1.
I know theres a remove duplicates, but I just want to mark them, not remove.
I was thinking something with the filtering. I know when you filter you can select multiple criteria, so if u have a column with 20 different values in it, you can select 5 values in the filter and it will show rows with those 5 values for the particular column. So i recorded a macro of that, and checked out the code, and I see for that it uses a string array, where each value to search for is in a string array. Is there any way to just specify an entire column and add every value to the string array?
thanks in advance
Here are three different ways to load items into an array. The first method is much faster but simply stores everything in the column. You have to be careful with this though because it creates a multidimensional array which isn't something that can be passed to AutoFilter.
Method 1:
Sub LoadArray()
Dim strArray As Variant
Dim TotalRows As Long
TotalRows = Rows(Rows.Count).End(xlUp).Row
strArray = Range(Cells(1, 1), Cells(TotalRows, 1)).Value
MsgBox "Loaded " & UBound(strArray) & " items!"
End Sub
Method 2:
Sub LoadArray2()
Dim strArray() As String
Dim TotalRows As Long
Dim i As Long
TotalRows = Rows(Rows.Count).End(xlUp).Row
ReDim strArray(1 To TotalRows)
For i = 1 To TotalRows
strArray(i) = Cells(i, 1).Value
Next
MsgBox "Loaded " & UBound(strArray) & " items!"
End Sub
if you know the values ahead of time and just want to list them in a variable you can assign a variant using Array()
Sub LoadArray3()
Dim strArray As Variant
strArray = Array("Value1", "Value2", "Value3", "Value4")
MsgBox "Loaded " & UBound(strArray) + 1 & " items!"
End Sub
not sure if anyone else will have this problem or not so I figured I'd post the answer I found. I like the solution of the array posted by #Ripster (and thanks for that, it almost worked) but it won't really work in this case. What I'm working with is a large sheet of data with 1 ID column, and I want to check other sheets to see if there are duplicates in that sheet (using ID column). not delete though, just mark so I can check them out. With potentially upwards of 50K rows looping through each row would take a LONG time.
So, what I figured out I can do is copy the ID column from the other sheet into the main sheet, and use the conditional formatting option to mark duplicates in some colour. (It'll mark the rows in both columns) and then I can filter the column by colour to show me only the colour I used to mark the duplicates. If I programmatically add a column to the sheet I'm checking with the row numbers, I can even include that column in the main sheet so when I filter for colour I can see which rows they were in their sheet.
After doing that I can record and adapt a macro to do this automatically for my less programming inclined co-workers
Thanks much all!
Edit - Added Code
After selecting the columns to compare, here is the code to mark the duplicates with red text and no fill:
Selection.FormatConditions.AddUniqueValues
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).DupeUnique = xlDuplicate
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
and then, since both columns have the duplicates marked you select the one that you actually want to examine and heres the code to filter:
`Selection.AutoFilter
ActiveSheet.Range("$C$1:$C$12").AutoFilter Field:=1, Criteria1:=RGB(156, 0 _
, 6), Operator:=xlFilterFontColor`
(in my test i used column c as the one to filter, that can be programmatically with a cells() reference or a range(cells(), cells()) sort of reference
I wish everyone the best of luck in their future endevors! thanks again to #ripster